• over_clox@lemmy.world
      link
      fedilink
      English
      arrow-up
      6
      ·
      16 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
        4
        ·
        16 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
          4
          ·
          16 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.