Rediscovering CGA with Pygmy Forth

July 22, 2023

Brad Nelson / @flagxor

Fonts from: https://int10h.org/oldschool-pc-fonts/download/

Blink vs Intensity

CGA

• Motorola 6845 Display Controller
• 16K RAM
• RGBI and Composite Output

Color Graphics Adapter

CGA Graphics Modes

• 80x25 16-color Text
• 40x25 16-color Text
• 320x200 4-color Graphics
• 640x200 2-color Graphics

CGA 320x200 Palettes

• Mode 4, Palette 0, Low Intensity
• Mode 4, Palette 0, High Intensity
• Mode 4, Palette 1, Low Intensity
• Mode 4, Palette 1, High Intensity
• Mode 5, Low Intensity
• Mode 5, High Intensity

Issues...

• Limited, weird color
• Fairly low-res text
• 1:1.2 / 1:2.4 pixel ratio
• "Snow" due to bandwidth in all but 40x25 mode
• No interrupts for refresh / timed changes

Alternatives

• Monochrome Display Adapter:
  80x25 Text Only Monochrome w/Intensity,
  720x350 Text resolution (9x14), 4k
• Later Hercules:
  720x348 1-bit Graphics, 2 pages, 64K
• Artifact Color

Artifact Color

• High frequency intensity change interpreted as color by TVs
• Similar approach to Apple II Double-res
• Allows 160x200 16-color
• Most common early in CGA's life cycle when monitors were rare

Memory Map

3D8h Mode Control

BIOS Modes

All Modes

3D9h Color Select

3DAh Status

Motorola MC6845

• 0 - Horizontal Total (in chars)
• 1 - Horizontal Displayed (in chars)
• 2 - Horizontal Sync Position (in chars)
• 3 - Horizontal Sync Width (in chars)
• 4 - Vertical Total (in char rows)
• 5 - Vertical Total Adjustment (in scanlines)
• 6 - Vertical Displayed (in char rows)
• 7 - Vertical Sync Position (in char rows)
• 8 - Interlace Mode
• 9 - Max Scan Lines Addressed (in scanlines)

Motorola MC6845

• 10 - Cursor start (in scanlines) + blink rate
• 11 - Cursor end (in scanlines)
• 12 - Start Address High
• 13 - Start Address Low
• 14 - Cursor Address High (R/W)
• 15 - Cursor Address Low (R/W)
• 16 - Light Pen Address High (R)
• 17 - Light Pen Address Low (R)

Brute force CGA16

• Try each of the 65,536 shape + color options
• Pick the closest fit vs an input image
• Tried it first in Python, too slow! 20 minutes!
• 20 seconds in C, haven't tried Forth

How about real time?

• Run DOS code that can actually use this mode
• Work around the funny limitations

Pygmy Forth

• Created by Frank Sargent
• Targets DOS, tiny memory model (64k code+data)
• Uses blocks extensively, but supports files too
• Includes assembler and screen block editor
• Meta-compiler
• My first Forth

Random Number Generator

( RANDOM NUMBER GENERATOR )
VARIABLE SEED1 VARIABLE SEED2  1 SEED1 !  1 SEED2 !
: LSHIFT ( N N -- N ) FOR 2* NEXT ;
: RSHIFT ( N N -- N ) FOR 2/ NEXT ;
: NEXT-RANDOM   SEED1 @ 7 LSHIFT SEED1 @ XOR SEED1 !
                SEED1 @ 8 RSHIFT SEED1 @ XOR SEED1 !
                SEED1 @ 9 LSHIFT SEED1 @ XOR SEED1 !
                SEED1 @ SEED2 +!
                SEED2 @ 7 LSHIFT SEED2 @ XOR SEED2 !
                SEED2 @ 8 RSHIFT SEED2 @ XOR SEED2 !
                SEED2 @ 9 LSHIFT SEED2 @ XOR SEED2 ! ;
: RANDOM16 ( -- N ) SEED2 @ NEXT-RANDOM ;
: RANDOM ( N -- N ) RANDOM16 SWAP UMOD ;
          

INT 10h

( BIOS GRAPHICS )
CODE INT10 ( A B C D -- )
  BX DX MOV,
  CX POP,
  BX POP,
  AX POP,
  $10 #, INT,
  BX POP,
  NXT,
END-CODE

: SCREEN   0 0 0 INT10 ;
: HOME   $0200 0 0 0 INT10 ;
          

Raw CGA

( CGA RAW HANDLING )
: CGA-REG! ( n rn -- ) $3D4 PC! $3D5 PC! ;
: CGA-MODE! ( n -- ) $3D8 PC! ;
: CGA-COLOR! ( n -- ) $3D9 PC! ;
: CGA-CHARLINES! ( n -- ) 1- 9 CGA-REG! ;
: CGA-ROWS! ( n -- ) 6 CGA-REG! ;

$B800 CONSTANT DISPLAY
: DISPC@ ( A -- N ) DISPLAY SWAP LC@ ;
: DISPC! ( N A -- ) DISPLAY SWAP LC! ;

: GRF16-MODE   2 SCREEN 2 CGA-CHARLINES! 9 CGA-MODE! 100 CGA-ROWS! ;
: TEXT-MODE   2 SCREEN 8 CGA-CHARLINES! 25 CGA-ROWS! ;
          

BLOAD

( BLOADING )
VARIABLE LOADING
: >DISP ( A A )
   1024 FOR
     OVER OVER I + SWAP I + C@ SWAP
     DISPLAY SWAP LC!
   NEXT 2DROP ;
: BLOAD ( str -- ) FOPEN DROP LOADING !
    HERE 7 LOADING @ FILE-READ
    0 16 FOR HERE 1024 LOADING @ FILE-READ
             HERE OVER >DISP 1024 + NEXT DROP
    LOADING @ FCLOSE ;
          

Generic Graphics

( GENERIC GRAPHICS )
VARIABLE WIDTH   VARIABLE HEIGHT
VARIABLE PATTERN
DEFER PLOT
: ROW ( X Y W -- ) OVER 0< PUSH OVER HEIGHT @ 1- > POP OR IF 3DROP EXIT THEN
                   SWAP PUSH OVER + WIDTH @ 1- MIN PUSH 0 MAX POP OVER - POP SWAP
                   DUP 0< IF 3DROP EXIT THEN
                   FOR 2DUP PLOT SWAP 1+ SWAP NEXT 2DROP ;
: BOX ( X Y W H -- ) FOR 3DUP ROW SWAP 1+ SWAP NEXT 2DROP DROP ;
          

160x100x16

( MODE 160x100 )
: PLOT1P ( X Y -- A ) 160 * SWAP $FFFE AND + 1+ DUP DISPC@ ;
: PLOT1AA ( X Y -- ) PLOT1P $F0 AND PATTERN C@ $0F AND OR SWAP DISPC! ;
: PLOT1BA ( X Y -- ) PLOT1P $0F AND PATTERN C@ $F0 AND OR SWAP DISPC! ;
: PLOT1AB ( X Y -- ) PLOT1P $F0 AND PATTERN 1+ C@ $0F AND OR SWAP DISPC! ;
: PLOT1BB ( X Y -- ) PLOT1P $0F AND PATTERN 1+ C@ $F0 AND OR SWAP DISPC! ;
CREATE PLOT1-OPS ' PLOT1AA , ' PLOT1BA , ' PLOT1AB , ' PLOT1BB ,
: PLOT1 ( X Y -- ) OVER 1 AND OVER 1 AND 2* + 2* PLOT1-OPS + @ EXECUTE ;
: 160x100   GRF16-MODE
            8000 FOR 221 DISPLAY I 2* L! NEXT
            ['] PLOT1 IS PLOT
            160 WIDTH ! 100 HEIGHT ! ;
          

320x200x4

( MODE 320x200 )
: PLOT2A ( X Y -- ) 2/ 80 *
                    PUSH DUP 3 AND SWAP 2 RSHIFT POP +
                    SWAP 3 SWAP 3 XOR 2* LSHIFT
                    OVER DISPC@ OVER $FFFF XOR AND SWAP PATTERN C@ AND OR
                    SWAP DISPC! ;
: PLOT2B ( X Y -- ) 2/ 80 * $2000 +
                    PUSH DUP 3 AND SWAP 2 RSHIFT POP +
                    SWAP 3 SWAP 3 XOR 2* LSHIFT
                    OVER DISPC@ OVER $FFFF XOR AND SWAP PATTERN 1+ C@ AND OR
                    SWAP DISPC! ;
: PLOT2 ( X Y -- ) DUP 1 AND IF PLOT2B ELSE PLOT2A THEN ;
: 320x200   5 SCREEN
            8000 FOR 0 DISPLAY I 2* L! NEXT
            ['] PLOT2 IS PLOT
            320 WIDTH ! 200 HEIGHT ! ;
          

640x200x2

( MODE 640x200 )
: PLOT3A ( X Y -- ) 2/ 80 *
                    PUSH DUP 7 AND SWAP 3 RSHIFT POP +
                    SWAP 1 SWAP 7 XOR LSHIFT
                    OVER DISPC@ OVER $FFFF XOR AND SWAP PATTERN C@ AND OR
                    SWAP DISPC! ;
: PLOT3B ( X Y -- ) 2/ 80 * $2000 +
                    PUSH DUP 7 AND SWAP 3 RSHIFT POP +
                    SWAP 1 SWAP 7 XOR LSHIFT
                    OVER DISPC@ OVER $FFFF XOR AND SWAP PATTERN 1+ C@ AND OR
                    SWAP DISPC! ;
: PLOT3 ( X Y -- ) DUP 1 AND IF PLOT3B ELSE PLOT3A THEN ;
: 640x200   6 SCREEN
            8000 FOR 0 DISPLAY I 2* L! NEXT
            ['] PLOT3 IS PLOT
            640 WIDTH ! 200 HEIGHT ! ;
          

Approaching direct CGA16

• Know the shape (upper two lines) of each character
• Replace least used old color when adding a color in an 8x2 character
• Ignore "attribute clash"
• Pick characters with a reverse mapping for a 2x2 area (limits things to 160x200)

BIOS Character Set

( BIOS CHARSET )
$000E CONSTANT LOCHAR-ADDR
$FFA6 CONSTANT LOCHAR-SEG
$0000 $007C L@ CONSTANT HICHAR-ADDR
$0000 $007E L@ CONSTANT HICHAR-SEG
: BIOSCH ( N -- N )
   DUP 128 < IF
     8 * LOCHAR-ADDR + LOCHAR-SEG
   ELSE
     128 - 8 * HICHAR-ADDR + HICHAR-SEG
   THEN
   SWAP
;
          

Special characters

Special characters

CREATE NIB2CHAR
  0 C,   0 C,   133 C, 0 C,   160 C, 0 C,   31 C,  1 C,
  149 C, 0 C,   221 C, 0 C,   238 C, 0 C,   162 C, 1 C,
  162 C, 0 C,   238 C, 1 C,   221 C, 1 C,   149 C, 1 C,
  31 C,  0 C,   160 C, 1 C,   133 C, 1 C,   0 C,   1 C,
: >CH ( N -- N ) 2* NIB2CHAR + @ ;

CREATE CHAR2NIB   256 ALLOT   CHAR2NIB 256 0 FILL
: MAKE-CHAR2NIB
   16 FOR
     I >CH $100 < IF
       I I >CH CHAR2NIB + C!
     THEN
   NEXT
;
MAKE-CHAR2NIB
: >NIB ( N -- N ) CHAR2NIB + C@ ;

: NIBSWAP ( N -- N ) DUP 4 LSHIFT $F0 AND SWAP 4 RSHIFT $F AND OR ;
          

160x200

( MODE 160x200 )
: PLOT4A ( A NIB -- )
   >CH DUP $100 AND IF PUSH DUP 1+ DISPC@ NIBSWAP OVER 1+ DISPC! POP THEN
   SWAP DISPC! ;
: PLOT4F ( A N -- ) PUSH DUP DISPC@ >NIB POP OR PLOT4A ;
: PLOT4B ( A N -- ) PUSH DUP DISPC@ >NIB POP $F XOR AND PLOT4A ;
          

160x200 (cont)

: PLOT4P ( X Y B -- )
   PUSH 2/ 160 * SWAP $FFFE AND +
   DUP 1+ DISPC@ $F AND PATTERN C@ = IF
     POP PLOT4F EXIT
   THEN
   DUP 1+ DISPC@ $F0 AND 4 RSHIFT PATTERN C@ = IF
     POP PLOT4B EXIT
   THEN
   DUP DISPC@ >NIB POPCNT 2 > IF
     DUP 1+ DISPC@ $F AND PATTERN @ 4 LSHIFT OR OVER 1+ DISPC!
     POP PLOT4B
   ELSE
     DUP 1+ DISPC@ $F0 AND PATTERN @ OR OVER 1+ DISPC!
     POP PLOT4F
   THEN
;
          

160x200 (cont)

: PLOT4 ( X Y -- ) OVER 1 AND OVER 1 AND 2* + 1 SWAP LSHIFT PLOT4P ;
: 160x200   GRF16-MODE
            8000 FOR $F000 DISPLAY I 2* L! NEXT
            ['] PLOT4 IS PLOT
            160 WIDTH ! 200 HEIGHT ! ;
          

DEMO TIME

⚘

Thank you