$PAGINATE
$title(Arnold 5 test)
$subtitle(Test of 27 color palette by drawing a Dulux color chart)
$copyright(Copyright (c) 1989, 1990, Amstrad plc.)
$pagewidth=131

        PUBLIC  UpperPalette27Test      ;called indirectly from TESTPACK
                                        ; out of MainMenuTable

        EXTERN  ScreenSetMode           ;in SUPPORT
        EXTERN  ScreenResetPalette      ;in SUPPORT
        EXTERN  SetCursorPos            ;in SUPPORT
        EXTERN  PrintStringHL           ;in SUPPORT
        EXTERN  KeyboardReadNoDelay     ;in SUPPORT
        EXTERN  .Mode0MaskTable         ;in MESSAGES
        EXTERN  .Pal27TestMess          ;in MESSAGES
        EXTERN  .PalWhiteoutMess        ;in MESSAGES
        EXTERN  .Pal27Line1Mess         ;in MESSAGES
        EXTERN  .Pal27Line9Mess         ;in MESSAGES
        EXTERN  .Pal27Line17Mess        ;in MESSAGES
        EXTERN  .PalVector0to8          ;in MESSAGES
        EXTERN  .PalVector9to11         ;in MESSAGES
        EXTERN  .PalVector12to1A        ;in MESSAGES

        EXTERN  ?Palette27Background    ;in TESTVARS
        EXTERN  ?Pal27LastKeyPressed    ;in TESTVARS
        EXTERN  ?Pal27TimesKeyPressed   ;in TESTVARS
        EXTERN  ?Palette27Timeout       ;in TESTVARS

        DEFSEG  FloppyDiskTest, CLASS=CODE

        SEG     FloppyDiskTest

;==================
UpperPalette27Test:
;==================
;
; This is gonna be just like Rolands old Dulux shade card. (He's bound to
; say - not as good !). Wot I'm gonna do is write a screen as follows in
; MODE 2:
;
;  <-------------------------------------80---------------------------------------->
; ͻ
;                                                                                 0  At F/F switch MODE 2 define inks 2..10
;                     Bright                          Bright          Bright      1
;     Black   Blue    Blue    Red     Magenta Mauve   Red     Purple  Magenta     2
;                                                                                 3  Line 3 MODE 0
;                  4
;     PEN 2 PEN 3 PEN 4 PEN 5 PEN 6 PEN 7 PEN 8 PEN 9 PEN A     5
;                  6
;                  7
;                                                                                 8  Line 8 MODE 2 define inks 2..10
;                     Sky                     Pastel                  Pastel      9
;     Green   Cyan    Blue    Yellow  White   Blue    Orange  Pink    Magenta     10
;                                                                                 11 Line 11 MODE 0
;                  12
;     PEN 2 PEN 3 PEN 4 PEN 5 PEN 6 PEN 7 PEN 8 PEN 9 PEN A     13
;                  14
;                  15
;                                                                                 16 Line 16 MODE 2 define inks 2..10
;     Bright  Sea     Bright          Pastel  Pastel  Bright  Pastel  Bright      17
;     Green   Green   Cyan    Lime    Green   Cyan    Yellow  Yellow  White       18
;                                                                                 19 Line 19 MODE 0
;                  20
;     PEN 2 PEN 3 PEN 4 PEN 5 PEN 6 PEN 7 PEN 8 PEN 9 PEN A     21
;                  22
;                  23
;                                                                                 24
; ͼ
;
;  That is print line 1  "   ...Bright  ...Bright"
;                line 2  "    Black   Blue    Blue...."
;                line 9  "   ..Sky      ...Pastel"
;                line 10 "   Green  Cyan   Blue...."
;                line 17 "   Bright  Sea    Bright...."     all in PEN 1
;                line 18 "   Green   Green  Cyan..."        all in MODE 2
;
; Then for lines 4, 12 and 20 call routine to print 9 blobs made of 8 chars
; by 4 lines deep. Stuffing in the masks to show PEN 2, 3, 4,... ,10
; The start addresses for lines 4, 12 and 20 are: 0C140h, 0C3C0h, 0C640h
; The algorithm to POKE the blobs is:
;
; FOR line=0 TO 3
;  FOR scan=0 TO 7
;   table_pointer = addr(table)
;   FOR blob=0 to 8
;    FOR byte=0 TO 7
;     POKE location,(table_pointer)
;     INC location
;    NEXT byte
;    INC location ;(leave 1 space between the blobs)
;    INC table_pointer
;   NEXT blob
;   location=location + 800h (down a scan) - 72 (cos we've gone across that many)
;  NEXT scan
;  location=location + 80 (down a char line) + &c000 (cos it wraps over FFFF..0)
; NEXT line
;
        ld      a,2
        call    ScreenSetMode

        ld      hl,0C00h                ;a minutes worth
        ld      (?Palette27Timeout),hl  ;time delay before we end

        ld      a,0
        ld      (?Palette27Background),a ;The grey scale number
        call    _PalSetBackground

        ld      a,4
        ld      (?Pal27TimesKeyPressed),a ;keyboard debounce counter

        ld      de,00027h
        call    SetCursorPos
        ld      hl,.Pal27TestMess
        ld      b,1
        call    PrintStringHL           ;tell user that V^ vary background

        ld      de,00127h
        call    SetCursorPos
        ld      hl,.PalWhiteoutMess
        ld      b,1
        call    PrintStringHL

        ld      de,00214h               ;(20,2)
        call    SetCursorPos
        ld      b,1                     ;out to screen
        ld      hl,.Pal27Line1Mess
        call    PrintStringHL

        ld      de,00A14h               ;(20,9)
        call    SetCursorPos
        ld      b,1                     ;out to screen
        ld      hl,.Pal27Line9Mess
        call    PrintStringHL

        ld      de,01204h               ;(4,17)
        call    SetCursorPos
        ld      b,1                     ;out to screen
        ld      hl,.Pal27Line17Mess
        call    PrintStringHL

        ld      hl,0C144h               ;line 4 + indent of 4 spaces
        call    _Pal27DrawBlobs
        ld      hl,0C3C4h               ;line 12 + indent of 4 spaces
        call    _Pal27DrawBlobs
        ld      hl,0C644h               ;line 20 + indent of 4 spaces
        call    _Pal27DrawBlobs

;
; Now the screen information is all there we can worry about displaying it
; correctly. This involves waiting for the leading edge of flame fryback to
; synchronise. We then go into the main display loop where a second test is
; made to see that F/F is active (for subsequent loops really to catch the
; leading edge). We then use the value in BC' to switch the MC0/MC1 bits to
; MODE 2. This will have the instant effect that the following scans are in
; that mode. As the scan continues down across lines 0, 1 and 2 we have a
; bit of time to program inks 2 to 10 with the first 9 colors in preparation
; for when the scan hits line 4. Any extra time we waste by a quick count on
; fingers and toes. When the scan gets to a bit above line 4 (3 1/2 ?) we
; use BC' to switch to MODE 0 so that the blobs are shown correctly. A goodly
; fingers and toes is performed till the scan is off line 7 and then a mode
; switch to MODE 2 is made so that lines 8 and 9 will display correctly. We now
; have 3 char lines to set PENs 2..10 for the second line of blobs, wait a
; bit and then at about line 11 we switch to MODE 0 and then wait. Around line
; 16 we then switch back to MODE 2 and start setting PENs 2 to 10 for the final
; line of blobs. At line 19ish we make a switch to MODE 0 and loop back round.
; As described, the start of the loop has a wait til F/F which will re-sync
; for the next time round.
;

        ld      bc,0F500h               ;8255 port B (bit 0 is f/f)
_PalWaitFFLow:
        in      a,(c)
        bit     0,a                     ;this will set Z if bit 0 = 0
        jr      nz,_PalWaitFFLow        ;need to see it low
;
; out of FF
;
_PalWaitFFHigh:
        in      a,(c)
        bit     0,a
        jr      z,_PalWaitFFHigh        ;then wait for the low to high edge
;
; we've now seen the leading edge of FF - it's just started
;
_PalDisplayMainLoop:
        ld      bc,0F500h
_PalMainWaitFFHigh:
        in      a,(c)                   ;first time thru we have just seen FF
        bit     0,a                     ;so this will fall thru. On subsequent
        jr      z,_PalMainWaitFFHigh    ;loops it'll wait till FF leading edge

        call    _PalSwitchMODE2         ;at line 0

        ld      de,.PalVector0to8       ;while we've got time set some inks
        call    _PalSetInks2toA

        ld      hl,388h
        call    _PalTwiddleThumbs       ;then pad out til next exciting point

        call    _PalSwitchMODE0         ;at line 3

        ld      hl,170h
        call    _PalTwiddleThumbs       ;now delay til line 7..8

        call    _PalSwitchMODE2         ;at line 8

        ld      de,.PalVector9to11
        call    _PalSetInks2toA

        ld      hl,0B0h
        call    _PalTwiddleThumbs       ;now showing second lump of text

        call    _PalSwitchMODE0         ;at line 11

        ld      hl,170h
        call    _PalTwiddleThumbs       ;about 4 lines worth

        call    _PalSwitchMODE2         ;at line 16

        ld      de,.PalVector12to1A
        call    _PalSetInks2toA

        ld      hl,0B0h
        call    _PalTwiddleThumbs

        call    _PalSwitchMODE0         ;at line 19

        ld      hl,170h
        call    _PalTwiddleThumbs

        ld      hl,(?Palette27Timeout)
        dec     hl
        ld      (?Palette27Timeout),hl
        ld      a,h
        or      l
        jr      z,_PalEndTest
  
        call    KeyboardReadNoDelay
        cp      0FFh
        jp      z,_PalDisplayMainLoop   ;no key pressed so loop
        ld      hl,?Pal27LastKeyPressed
        cp      (hl)                    ;is the same key as last time pressed
        ld      (hl),a                  ;store this one
        jp      nz,_PalDisplayMainLoop  ;different key so loop
        ld      hl,?Pal27TimesKeyPressed
        dec     (hl)
        jp      nz,_PalDisplayMainLoop
        push    af
        ld      a,4                     ;number of times it must be pressed
        ld      (hl),a                  ;reset debounce counter
        pop     af
        cp      66                      ;is ESC pushed
        jp      z,_PalEndTest
        cp      76                      ;is Joy 0 Fire 0 pressed = End
        jp      z,_PalEndTest
        cp      0                       ;is the key UP
        jr      z,_PalIncreaseBackground
        cp      72                      ;up on the joystick
        jr      z,_PalIncreaseBackground
        cp      2                       ;down on keyboard
        jr      z,_PalDecreaseBackground
        cp      73                      ;down on joystick
        jr      z,_PalDecreaseBackground
        cp      1
        jr      z,_PalDoWhiteOut
        cp      8
        jr      z,_PalDoWhiteOut
        cp      74
        jr      z,_PalDoWhiteOut
        cp      75
        jr      z,_PalDoWhiteOut
        jp      _PalDisplayMainLoop

_PalIncreaseBackground:
        ld      a,(?Palette27Background)
        inc     a
        cp      27
        jr      nz,_PalIncreaseSetIt
        ld      a,0
_PalIncreaseSetIt:
        ld      (?Palette27Background),a
        call    _PalSetBackground
        jp      _PalDisplayMainLoop

_PalDecreaseBackground:
        ld      a,(?Palette27Background)
        dec     a
        jp      p,_PalDecreaseSetIt
        ld      a,26
_PalDecreaseSetIt:
        ld      (?Palette27Background),a
        call    _PalSetBackground
        jp      _PalDisplayMainLoop

_PalEndTest:
        call    ScreenResetPalette      ;put things back to normal

        xor     a                       ;clear carry
        ret

_PalDoWhiteout:
;
; For luminance testing this sets the whole screen (including border) to white.
;
        ld      hl,0C000h
        ld      c,0
_WhiteClearScreen:
        ld      (hl),c
        inc     hl
        ld      a,h
        or      l
        jr      nz,_WhiteClearScreen

        ld      bc,7F00h                ;pen 0
        out     (c),c
        ld      bc,7F4Bh                ;bright white
        out     (c),c
        ld      bc,7F10h                ;the border
        out     (c),c
        ld      bc,7F4Bh
        out     (c),c

_WhiteWaitKey:
        call    KeyboardReadNoDelay
        cp      0FFh
        jr      z,_WhiteWaitKey

        ld      bc,07F10h
        out     (c),c                   ;point at border
        ld      bc,07F56h
        out     (c),c                   ;make it the normal green

        jp      UpperPalette27Test      ;then restart this whole test


;=================
_PalSetBackground:
;=================
;
; Use (?Palette27Background), look it up in the conversion table at
; "PalVector0To8" to convert from grey to h/w colour then set background.
; Also add 14 to it mod 27 and look that up to set PEN 1.
;
        ld      h,0
        ld      a,(?Palette27Background)
        ld      l,a
        ld      bc,.PalVector0To8
        add     hl,bc
        ld      a,(hl)
        or      40h                     ;add in the palette memory bit
        ld      bc,07F00h                ;
        out     (c),c                   ;point at colour 0 (background)
        out     (c),a

        ld      a,(?Palette27Background)
        add     14
        cp      28
        jr      c,_PalBackNoWrap
        sub     27                      ;bring it back into range
_PalBackNoWrap
        ld      h,0
        ld      l,a
        ld      bc,.PalVector0To8
        add     hl,bc
        ld      a,(hl)
        or      40h
        ld      bc,7f01h
        out     (c),c                   ;point at PEN 1 entry
        out     (c),a                   ;set to inverse of background
        ret



;===============
_Pal27DrawBlobs:
;===============
;
; HL points to start of line (CxF0h). Algorithm is described above.
;
        ld      b,5                     ;FOR lines: 5 of 'em
_Pal27BarsLineloop:
        ld      c,8                     ;FOR scans: 8 on current 8*8
_Pal27BarsScanLoop:
        push    bc
        ld      de,.Mode0MaskTable+2    ;table_pointer = ADDR (table)
        ld      b,9                     ;FOR blobs: 9 to make a line
_Pal27BarsBlobLoop:
        ld      c,7                     ;FOR byte: 7 for each color blob
_Pal27BarsByteLoop:
        ld      a,(de)
        ld      (hl),a                  ;POKE location, (table pointer)
        inc     hl                      ;INC Location
        dec     c
        jr      nz,_Pal27BarsByteLoop   ;NEXT byte

        inc     hl                      ;INC location (space between blobs)
        inc     de                      ;INC table pointer
        djnz    _Pal27BarsBlobLoop      ;NEXT blob

        ld      de,800h - 72
        add     hl,de                   ;location=location + 800h - 72
        pop     bc                      ;get two outer counters back
        dec     c
        jr      nz,_Pal27BarsScanLoop   ;NEXT scan

        ld      de,0C000h + 80
        add     hl,de                   ;wraps back down to next char line

        djnz    _Pal27BarsLineLoop      ;NEXT line

        ret

;===============
_PalSetInks2toA:
;===============
;
; At three occasions down the screen we want to program the ULA palette
; registers for inks 2 to 10 with certain values - a vector of the 9 to
; set is passed in DE
;
        push    bc
        ld      l,9                     ;number of inks to set
_PalSetInkLoop:
        ld      a,11
        sub     l                       ;so A is (11 - counter) (ie 2, 3...10)
        ld      b,07Fh                  ;addr of ULA
        out     (c),a                   ;select the palette register (2..10)
        ld      a,(de)                  ;get desired ink value
        or      040h                    ;make top 010 (to set value into pal)
        out     (c),a
        inc     de                      ;move along vector
        dec     l
        jr      nz,_PalSetInkLoop
        pop     bc
        ret

;===============
_PalSwitchMODE2:
;===============
;
; Obvious ?
;
        exx                             ;access BC' to get at MC0/1 bits
        ld      a,c
        and     0FCh                    ;clear MC0/1
        or      2                       ;set MODE 2
        ld      c,a
        ld      b,07Fh
        out     (c),c                   ;switch to MODE 2
        exx
        ret

;===============
_PalSwitchMODE0:
;===============
;
; Obvious ?
;
        exx                             ;access BC' to get at MC0/1 bits
        ld      a,c
        and     0FCh                    ;clear MC0/1 to MODE 0
        ld      c,a
        ld      b,07Fh
        out     (c),c                   ;switch to MODE 0
        exx
        ret


_PalTwiddleThumbs:
;
; Delay for length indicated in HL
;
        dec     hl
        ld      a,h
        or      l
        jr      nz,_PalTwiddleThumbs
        ret

        END
