• over_clox@lemmy.world
    link
    fedilink
    English
    arrow-up
    4
    ·
    6 hours ago

    Sure, have at it!

    Sorry it’s not a full complete dump with examples, but it’s programmed in QBasic 1.1 and converts raw RGB pixel data into equivalent closest matching color halftone onscreen characters. I designed it in mind with DOS text modes of either 80x25, 80x43, or 80x50 text modes, but I’m sure the technique can work with any text mode that can properly render the old DOS block characters. But, I’m betting that whatever device you’re using right now is almost certainly not configured to display the old DOS block characters as they were back in the day.

    Good luck!

    REM TEXTPSET.BAS
    REM over_clox - February 26, 2008
    
    DECLARE SUB DisplayRAW (FileName$, W%, H%)
    DECLARE SUB TextPSet (X%, Y%, R%, G%, B%)
    DECLARE SUB TextPixel (Red%, Green%, Blue%, Char$, FGround%, BGround%)
    DECLARE SUB HTMtoRGB (HTMColor$, Red%, Green%, Blue%)
    
    TYPE PaletteType
        R AS INTEGER
        G AS INTEGER
        B AS INTEGER
    END TYPE
    
    REDIM SHARED DOSPalette(15) AS PaletteType
    REDIM SHARED FakePalette(15, 7, 1 TO 3) AS PaletteType
    
    RESTORE
    FOR I% = 0 TO 15
        READ HTMColor$
        HTMtoRGB HTMColor$, R%, G%, B%
        DOSPalette(I%).R = R%
        DOSPalette(I%).G = G%
        DOSPalette(I%).B = B%
    NEXT
    
    FOR C% = 1 TO 3
        C2% = 4 - C%
        FOR B% = 0 TO 7
            FOR F% = 0 TO 15
                R1% = DOSPalette(F%).R: R2% = DOSPalette(B%).R
                G1% = DOSPalette(F%).G: G2% = DOSPalette(B%).G
                B1% = DOSPalette(F%).B: B2% = DOSPalette(B%).B
                FakePalette(F%, B%, C%).R = (R1% * C% + R2% * C2%) \ 4
                FakePalette(F%, B%, C%).G = (G1% * C% + G2% * C2%) \ 4
                FakePalette(F%, B%, C%).B = (B1% * C% + B2% * C2%) \ 4
            NEXT
        NEXT
    NEXT
    
    'MS-DOS Text Mode 16 Color Palette
    DATA 000000,0000AA,00AA00,00AAAA,AA0000,AA00AA,AA5500,AAAAAA
    DATA 555555,5555FF,55FF55,55FFFF,FF5555,FF55FF,FFFF55,FFFFFF
    
    CMD$ = COMMAND$
    IF CMD$ <> "" THEN
        DisplayRAW CMD$, 80, 25
    ELSE
        DisplayRAW "LOGO.RAW", 80, 25
    END IF
    
    'DEF SEG = &HB800: BSAVE "LOGO.BSV", 0, 4000
    
    COLOR 7, 0
    
    DO: Hit$ = UCASE$(INKEY$): LOOP WHILE Hit$ = ""
    
    SUB DisplayRAW (FileName$, W%, H%)
    
        FileNum% = FREEFILE
        OPEN FileName$ FOR BINARY AS FileNum%
        CLS : WIDTH W%, H%
        ScanLine$ = SPACE$(W% * 3)
        FOR Y% = 0 TO H% - 1
            GET #1, , ScanLine$
            FOR X% = 0 TO W% - 1
                R% = ASC(MID$(ScanLine$, X% * 3 + 1, 1))
                G% = ASC(MID$(ScanLine$, X% * 3 + 2, 1))
                B% = ASC(MID$(ScanLine$, X% * 3 + 3, 1))
                TextPSet X%, Y%, R%, G%, B%
            NEXT
        NEXT
        CLOSE FileNum%
    
    END SUB
    
    SUB HTMtoRGB (HTMColor$, Red%, Green%, Blue%)
        Red% = VAL("&H" + MID$(HTMColor$, 1, 2))
        Green% = VAL("&H" + MID$(HTMColor$, 3, 2))
        Blue% = VAL("&H" + MID$(HTMColor$, 5, 2))
    END SUB
    
    SUB TextPixel (Red%, Green%, Blue%, Char$, FGround%, BGround%)
        ' °±²Û (32,176,177,178,219)
       
        Diff% = 768: BGround% = 0
        FOR F% = 0 TO 15
            RDiff% = ABS(DOSPalette(F%).R - Red%)
            GDiff% = ABS(DOSPalette(F%).G - Green%)
            BDiff% = ABS(DOSPalette(F%).B - Blue%)
            NewDiff% = RDiff% + GDiff% + BDiff%
            IF NewDiff% < Diff% THEN
                Diff% = NewDiff%: Char$ = "Û": FGround% = F%
            END IF
        NEXT
    
        FOR C% = 1 TO 3
            C2% = 4 - C%
            FOR B% = 0 TO 7
                FOR F% = 0 TO 15
                    RDiff% = ABS(FakePalette(F%, B%, C%).R - Red%)
                    GDiff% = ABS(FakePalette(F%, B%, C%).G - Green%)
                    BDiff% = ABS(FakePalette(F%, B%, C%).B - Blue%)
                    NewDiff% = RDiff% + GDiff% + BDiff%
                    IF NewDiff% < Diff% THEN
                        Diff% = NewDiff%: Char$ = CHR$(175 + C%)
                        FGround% = F%: BGround% = B%
                    END IF
                NEXT
            NEXT
        NEXT
    
    END SUB
    
    SUB TextPSet (X%, Y%, Red%, Green%, Blue%)
        TextPixel Red%, Green%, Blue%, Char$, FGround%, BGround%
        LOCATE Y% + 1, X% + 1: COLOR FGround%, BGround%: PRINT Char$;
    END SUB
    
    • kora@sh.itjust.works
      link
      fedilink
      English
      arrow-up
      3
      ·
      6 hours ago

      You are amazing. Thank you very much for delivering! Half of the fun is discovering how it works without examples so no need to apologise :^)

      I need to look into running QBasic on my M4. Unsure about my options for now. Worst case scenario I spin up a VM tomorrow.

      • over_clox@lemmy.world
        link
        fedilink
        English
        arrow-up
        2
        ·
        6 hours ago

        Meh, DOSBox is plenty suitable enough, and QBasic is easy enough to find…

        https://winworldpc.com/product/qbasic/1x

        I can’t promise that DOSBox emulated results will give the exact color results as original old-school hardware on an old CRT, but results should still be mighty close.

        The raw input data files are pretty simple to generate with most graphics software, just downsample down to potato 80x25, then export to raw 888 RGB format.