10REM Program to save screens at the touch of a button
   20REM They will be appended to a given file
   30REM (C) John Robinson 1989
   40REM Best for mode 7 screens (it runs quickest then)
   50REM Method: Use the character entering buffer vector to test for the
   60REM            appropriate keypresses. If the right thing is found,
   70REM            don't put the character into the buffer, but instead save
   80REM            the current screen taking into account the hardware scroll
   90REM Note that the file format is 1 byte (mode number) followed by the
  100REM            screen itself
  110REM Also, if # on its own is given as the key, a prompt will be given,
  120REM            and you have to press the appropriate key combination
  130:
  140DIM code &400
  150origin=&900
  160insv=&22A: keyv=&228
  170bufferN=0
  180zp=&A8
  190gsinit=&FFC2
  200gsread=&FFC5
  210osfind=&FFCE
  220osgbpb=&FFD1
  230osbput=&FFD4
  240osargs=&FFDA
  250osrdch=&FFE0
  260osasci=&FFE3
  270osnewl=&FFE7
  280osbyte=&FFF4
  290oscli=&FFF7
  300:
  310FOR pass=4 TO 7 STEP 3
  320P%=origin
  330O%=code
  340[OPT pass
  350
  360.table
  370 .SHIFT EQUS "+shift" :EQUB 0
  380 .CTRL  EQUS "+ctrl"  :EQUB 0
  390
  400.get_key_parameter
  410LDA #0
  420STA ctrl
  430STA shift
  440JSR gsread
  450STA keyA
  460JSR gsread
  470BCC gsyntax_error
  480CLC
  490JSR gsinit
  500BEQ got_key_parameter
  510JSR check_for_SHIFT
  520BCS no_SHIFT
  530LDA #&FF
  540STA shift
  550.no_SHIFT
  560CLC
  570JSR gsinit
  580BEQ got_key_parameter
  590JSR check_for_CTRL
  600BCS no_CTRL
  610LDA #&FF
  620STA ctrl
  630.no_CTRL
  640CLC
  650JSR gsinit
  660BEQ got_key_parameter
  670.gsyntax_error
  680JMP syntax_error
  690.got_key_parameter
  700LDA keyA
  710CMP #ASC "#"
  720BNE dont_do_keycheck
  730LDA shift
  740BNE dont_do_keycheck
  750LDA ctrl
  760BNE dont_do_keycheck
  770LDX #presskeymsg-prompt_string
  780JSR message
  790JSR osrdch
  800BCC P%+5:JMP Escape
  810STA keyA
  820CLC
  830CLV
  840JSR oskeyA
  850PHP
  860PLA
  870AND #&C0
  880STA control_and_shiftA
  890JSR osnewl
  900JMP finished_with_key
  910.dont_do_keycheck
  920LDA #0
  930LSR shift
  940ROR A
  950LSR ctrl
  960ROR A
  970STA control_and_shiftA
  980.finished_with_key
  990RTS
 1000
 1010.check_for_SHIFT
 1020LDX #SHIFT-table
 1030JMP parse
 1040.check_for_CTRL
 1050LDX #CTRL-table
 1060.parse
 1070STY tempbyte
 1080.parse_loop
 1090LDA table,X
 1100BEQ word_found
 1110JSR gsread
 1120BCS word_not_found
 1130ORA #&20
 1140CMP table,X
 1150BNE check_abbr
 1160INX
 1170BNE parse_loop
 1180.check_abbr
 1190CMP #ASC "."
 1200BEQ word_found
 1210.word_not_found
 1220LDY tempbyte
 1230SEC
 1240RTS
 1250.word_found
 1260CLC
 1270RTS
 1280
 1290.shift EQUB TRUE
 1300.ctrl EQUB TRUE
 1310.tempbyte EQUB 0
 1320
 1330.save_screens
 1340LDY #0
 1350LDX #zp
 1360LDA #1
 1370JSR osargs
 1380LDY zp+1
 1390LDX zp
 1400STY &F3
 1410STX &F2
 1420LDY #0
 1430CLC
 1440JSR gsinit
 1450BNE there_is_a_parameter
 1460.syntax_error
 1470BRK
 1480EQUB 254
 1490EQUS "Syntax: *ScrSave <Filename> (<Char> (+SHIFT)(+CTRL))"
 1500EQUB 0
 1510.there_is_a_parameter
 1520LDX #0
 1530.get_filename
 1540JSR gsread
 1550BCS end_of_that_string
 1560STA initfilename,X
 1570INX
 1580BCC get_filename
 1590.end_of_that_string
 1600LDA #&D
 1610STA initfilename,X
 1620CLC
 1630JSR gsinit
 1640BEQ default_keys
 1650JSR get_key_parameter
 1660.default_keys
 1670LDY #initfilename DIV 256
 1680LDX #initfilename MOD 256
 1690LDA #&40
 1700JSR osfind
 1710TAY
 1720BEQ dont_ask_first
 1730LDA #0
 1740JSR osfind
 1750TAX
 1760JSR message
 1770.get_keypress
 1780JSR osrdch
 1790BCS Escape
 1800AND #&DF
 1810CMP #ASC "Y"
 1820BEQ says_yes
 1830CMP #ASC "N"
 1840BNE get_keypress
 1850JSR osasci
 1860JSR osnewl
 1870RTS
 1880.Escape
 1890BRK
 1900EQUB 17
 1910EQUS "Escape"
 1920EQUB 0
 1930.says_yes
 1940JSR osasci
 1950JSR osnewl
 1960LDA #&C0
 1970STA openbyteA
 1980.dont_ask_first
 1990LDY #runmodule2 DIV 256
 2000LDX #runmodule2 MOD 256
 2010JSR oscli
 2020LDA keyA
 2030STA key
 2040LDX #0
 2050.copy_filename
 2060LDA initfilename,X
 2070STA filename,X
 2080INX
 2090CMP #&D
 2100BNE copy_filename
 2110LDY #newins DIV 256
 2120LDX #newins MOD 256
 2130PHP
 2140SEI
 2150STY insv+1
 2160STX insv
 2170PLP
 2180LDX #second_message-prompt_string
 2190JSR message
 2200RTS
 2210
 2220.runmodule2
 2230EQUS "ScrS/2"
 2240EQUB &D
 2250
 2260.message
 2270LDA prompt_string,X
 2280BEQ done_message
 2290JSR osasci
 2300INX
 2310BNE message
 2320.done_message
 2330RTS
 2340
 2350.prompt_string
 2360EQUS "Already exists: Append? "
 2370EQUB 0
 2380.second_message
 2390EQUS "OK."
 2400EQUB &D
 2410EQUB 0
 2420.presskeymsg
 2430EQUS "Press appropriate keys now"
 2440EQUB 0
 2450
 2460.oskeyA
 2470JMP (keyv)
 2480
 2490.keyA EQUS "0"
 2500.control_and_shiftA EQUB &C0
 2510.openbyteA EQUB &80
 2520
 2530.initfilename
 2540]
 2550end_of_init=O%
 2560P%=origin
 2570[OPT pass
 2580.newins
 2590PHA
 2600TAY
 2610TXA
 2620PHA
 2630CMP #bufferN
 2640BNE exit_and_use_old_version
 2650CPY key
 2660BNE exit_and_use_old_version
 2670CLC
 2680CLV
 2690JSR oskey
 2700PHP
 2710PLA
 2720AND #&C0
 2730CMP control_and_shift
 2740BEQ do_the_works
 2750.exit_and_use_old_version
 2760PLA
 2770TAX
 2780PLA
 2790JMP (oldinsv)
 2800.do_the_works
 2810LDY #filename DIV 256
 2820LDX #filename MOD 256
 2830LDA openbyte
 2840JSR osfind
 2850STA gbpbblock
 2860TAY
 2870BNE P%+5:JMP exit
 2880LDX #zp
 2890LDA #2
 2900JSR osargs
 2910LDA #1
 2920JSR osargs
 2930LDA #&C0
 2940STA openbyte
 2950LDA &355
 2960LDY gbpbblock
 2970JSR osbput
 2980CMP #7
 2990BEQ no_colour_palette
 3000LDX #&FF
 3010.output_palette
 3020INX
 3030LDA &36F,X
 3040JSR osbput
 3050CPX &360
 3060BCC output_palette
 3070.no_colour_palette
 3080LDA #&FE
 3090STA memptr+2
 3100LDA #&FF
 3110STA memptr+3
 3120LDY &351
 3130LDX &350
 3140STY memptr+1
 3150STX memptr
 3160LDA #0
 3170STA nbytes+2
 3180STA nbytes+3
 3190SEC
 3200SBC memptr
 3210STA nbytes
 3220LDA #&80
 3230SBC memptr+1
 3240STA nbytes+1
 3250LDA #2
 3260LDY #gbpbblock DIV 256
 3270LDX #gbpbblock MOD 256
 3280JSR osgbpb
 3290LDY &34E
 3300LDX #0
 3310STY memptr+1
 3320STX memptr
 3330LDA &350
 3340SEC
 3350SBC memptr
 3360STA nbytes
 3370LDA &351
 3380SBC memptr+1
 3390STA nbytes+1
 3400LDA #2
 3410LDY #gbpbblock DIV 256
 3420LDX #gbpbblock MOD 256
 3430JSR osgbpb
 3440LDA #0
 3450LDY gbpbblock
 3460JSR osfind
 3470.exit
 3480PLA
 3490TAX
 3500PLA
 3510CLC
 3520RTS
 3530
 3540.oskey
 3550JMP (keyv)
 3560
 3570.key EQUS "0"
 3580.control_and_shift EQUB &C0
 3590.oldinsv EQUW &FFA6
 3600.gbpbblock
 3610 .handle EQUB 0
 3620 .memptr EQUD 0
 3630 .nbytes EQUD 0
 3640 .seqptr EQUD 0
 3650.openbyte EQUB &80
 3660.filename
 3670
 3680.eo_newins          \ This is only the end of the ACTIVE part
 3690
 3700.extra_init
 3710LDA control_and_shiftA
 3720STA control_and_shift
 3730LDA openbyteA
 3740STA openbyte
 3750LDY insv+1
 3760LDX insv
 3770STY oldinsv+1
 3780STX oldinsv
 3790RTS
 3800
 3810]
 3820NEXT pass
 3830:
 3840PRINT "Active code between &";~newins;" and &";~eo_newins
 3850save$="*SAVE ScrSave "+STR$~code+" "+STR$~end_of_init+" "+STR$~(save_screens OR &FFFF0000)+" "+STR$~(origin OR &FFFF0000)
 3860save2$="*SAVE ScrS/2 "+STR$~end_of_init+" "+STR$~O%+" "+STR$~(extra_init OR &FFFF0000)+" "+STR$~(origin OR &FFFF0000)
 3870PRINT save$'save2$'"(Y/N) ";
 3880IF (GET OR &20)=ASC "y" THEN PRINT "Yes":OSCLI save$:OSCLI save2$:PRINT "OK" ELSE PRINT "No"
 3890: