This is a patriotic example of keyboard/video screen handling. I admit this is embarrassingly inaccurate - it was a very quick lunch break exercise & I didn't have time to map out 50 stars & 13 stripes. Nonetheless, the program demonstrates the formation of blue, red & white blocks along with blinking stars activated by pressing the F1 key. Source code to follow. Take note of the style, neatness & efficiency of the code. It doesn't matter if I'm coding for a client project or creating a quick demo - every line must be professional, concise & worthy of presentation - always...
Sample GIF of the TDFLAG program with toggling stars:
The TDFLAG.ALC program begins with the standard IBM linkage conventions - the PC/370 application ensures the required elements are set properly from the operating system. R15 contains the program entry point address, R14 contains the return address (back to the O/S) & R13 is pointed to the external 18 fullword save area of the O/S.
TITLE 'TDFLAG - PC/370 4.2 DISPLAY FLAG // DELIA'
***********************************************************************
* *
* MODULE: TDFLAG. *
* AUTHOR: TONY DELIA. *
* DATE: 10/18/96. *
* DESC: DISPLAY FLAG. *
* NOTE: PC/370 RELEASE 4.2 *
* *
***********************************************************************
EJECT
***********************************************************************
* T D F L A G P R O G R A M *
***********************************************************************
TDFLAG START 0 START PROGRAM
STM 14,12,12(13) SAVE REGISTERS
LR 12,15 LOAD PROGRAM ENTRY POINT
USING TDFLAG+0*4096,12 BASE REGISTER 1
L 11,BASE2 LOAD BASE REGISTER 2
USING TDFLAG+1*4096,11 TELL ASSEMBLER ABOUT BASE2
L 10,BASE3 LOAD BASE REGISTER 3
USING TDFLAG+2*4096,10 TELL ASSEMBLER ABOUT BASE3
ST 13,SAVE+4 SAVE EXTERNAL SAVE ADDRESS
LR 14,13 XFER ADDRESS TO TEMP R14
LA 13,SAVE LOAD INTERNAL SAVE ADDRESS
ST 13,8(14) SAVE IN EXTERNAL SAVE AREA
B GO BRANCH TO PROCESSING RTN
***********************************************************************
RETURN EQU * TIME TO RETURN
L 13,SAVE+4 RESTORE REGISTER 13
LM 14,12,12(13) RESTORE REMAINING REGS
SR 15,15 CLEAR RETURN CODE
BR 14 BRANCH TO CALLING PROGRAM
***********************************************************************
SAVE DC 18F'0' S A V E A R E A
***********************************************************************
BASE2 DC A(TDFLAG+1*4096) BASE2 DISPLACEMENT
BASE3 DC A(TDFLAG+2*4096) BASE2 DISPLACEMENT
***********************************************************************
GO EQU * BEGIN PROCESSING ...
***********************************************************************
EJECT
The main procedure reads a table that defines the areas of blue, red & white along with the positions of the stars. It also accepts & interrogates keyboard input. If the F1 key is pressed it will toggle the stars blinking on or off... if any other key is pressed the program is stopped.
***********************************************************************
* MAINLINE PROCEDURE *
***********************************************************************
PRINT NOGEN
SVC @TRACE ISSUE SUPERVISOR CALL
DC CL4'IOF ' KEYBOARD INTERRUPT OFF
*
MVI VBITS,@BKWH SET BACKGROUND/FOREGROUND
BAL 6,VRESET CHANGE SCREEN ATTRIBUTES
*
LA 5,FLAG LOAD TABLE ADDRESS
LOOP EQU *
CLI 0(5),X'FF' END OF TABLE ???
BE LOOPX YES - EXIT PLEASE
*
MVC VXYS,0(5) MOVE CURSOR POSITION
BAL 6,VXYSET SET CURSOR POSITION
MVC VPUTL,4(5) MOVE LINE LENGTH
MVC VBITS,6(5) SET BACKGROUND/FOREGROUND
*
TM 7(5),X'01' ANY STARS ???
BNO *+10 NO - CONTINUE PLEASE
OC VBITS,BLINK YES - SET BLINK/TOGGLE
*
BAL 6,VPUT WRITE DUMMY LINE
*
TM 7(5),X'01' ANY STARS ???
BNO BUMP NO - CONTINUE PLEASE
*
MVC VXYS,0(5) MOVE CURSOR POSITION
BAL 6,VXYSET SET CURSOR POSITION
*
LA 2,STAR1 LOAD STAR 1 ADDRESS
TM 7(5),X'02' STAR LINE 2 ???
BNO *+8 NO - CONTINUE PLEASE
LA 2,STAR2 LOAD STAR 2 ADDRESS
*
SVC @WTO ISSUE SUPERVISOR CALL
BUMP EQU *
LA 5,8(,5) BUMP TABLE POINTER
B LOOP TEST NEXT TABLE ENTRY
LOOPX EQU *
MVC VXYS,=AL1(0,0,23,30) MOVE CURSOR POSITION
BAL 6,VXYSET SET CURSOR POSITION
MVC VPUTL,=Y(L'F1MSG) MOVE LINE LENGTH
MVI VBITS,@BKWT SET BACKGROUND/FOREGROUND
BAL 6,VPUT WRITE DUMMY LINE
LA 2,F1MSG LOAD MESSAGE ADDRESS
SVC @WTO ISSUE SUPERVISOR CALL
BAL 6,KBGET READ KEYBOARD INPUT
MVC KEY,KBCHR STORE KEYSTROKE
CLI KEY,@K#F1 KEY = F1 ???
BNE RETURN NO - EXIT PROGRAM
XC BLINK,TOGGLE ISOLATE UNIQUE BITS
XC TOGGLE,BLINK REPLACE TOGGLE W/BLINK
XC BLINK,TOGGLE REPLACE BLINK W/TOGGLE
LA 5,FLAG LOAD TABLE ADDRESS
B LOOP START OVER AGAIN...
***********************************************************************
BLINK DC XL1'00' BLINK ATTRIBUTE SETTING
TOGGLE DC XL1'80' TOGGLE BLINK SETTING
***********************************************************************
EJECT
I created various copybooks that contain routines for different purposes - this program uses the ones for video & keyboard along with the equate values for keystrokes, colors & supervisor/interrupt calls. The table named "FLAG" contains the block definitions for the blue, red & white areas as well as the bit settings to indicate stars.
***********************************************************************
* WORKING STORAGE *
***********************************************************************
KEY DC CL1' ' KEY STROKE (@RDKEY)
***********************************************************************
LTORG LITERAL POOL
***********************************************************************
@YES EQU C'Y' YES
@NO EQU C'N' NO
@ESC EQU 27 ESCAPE KEY
@CR EQU 13 CARRIAGE RETURN
@LF EQU 10 LINE FEED
@KEYLO EQU 32 ASCII KEY - LO VALUE
@KEYHI EQU 126 ASCII KEY - HI VALUE
***********************************************************************
* COPYBOOKS *
***********************************************************************
COPY CPY/TDVID.CPY COPYBOOK - VIDEO UTILITY
COPY CPY/TDKBD.CPY COPYBOOK - KEYBOARD INPUT
COPY CPY/TDKEY.CPY COPYBOOK - KEYSTROKES
COPY CPY/TDCLR.CPY COPYBOOK - COLORS
COPY CPY/TDSVC.CPY COPYBOOK - SUPERVISOR
***********************************************************************
F1MSG DC C'Press F1 to Toggle Blinking Stars... $'
***********************************************************************
STAR1 DC C' * * * * * $'
STAR2 DC C' * * * * $'
***********************************************************************
FLAG DS 0F
DC AL1(0,0,3,2),AL2(67),AL1(@RDWH,0)
DC AL1(0,0,5,2),AL2(67),AL1(@RDWH,0)
DC AL1(0,0,7,2),AL2(67),AL1(@RDWH,0)
DC AL1(0,0,9,2),AL2(67),AL1(@RDWH,0)
DC AL1(0,0,11,2),AL2(67),AL1(@RDWH,0)
DC AL1(0,0,13,2),AL2(67),AL1(@RDWH,0)
DC AL1(0,0,15,2),AL2(67),AL1(@RDWH,0)
DC AL1(0,0,17,2),AL2(67),AL1(@RDWH,0)
DC AL1(0,0,19,2),AL2(67),AL1(@RDWH,0)
DC AL1(0,0,21,2),AL2(67),AL1(@RDWH,0)
*
DC AL1(0,0,4,2),AL2(67),AL1(@WHWH,0)
DC AL1(0,0,6,2),AL2(67),AL1(@WHWH,0)
DC AL1(0,0,8,2),AL2(67),AL1(@WHWH,0)
DC AL1(0,0,10,2),AL2(67),AL1(@WHWH,0)
DC AL1(0,0,12,2),AL2(67),AL1(@WHWH,0)
DC AL1(0,0,14,2),AL2(67),AL1(@WHWH,0)
DC AL1(0,0,16,2),AL2(67),AL1(@WHWH,0)
DC AL1(0,0,18,2),AL2(67),AL1(@WHWH,0)
DC AL1(0,0,20,2),AL2(67),AL1(@WHWH,0)
*
DC AL1(0,0,3,2),AL2(21),AL1(@BLWH,0)
DC AL1(0,0,4,2),AL2(21),AL1(@BLWH,1)
DC AL1(0,0,5,2),AL2(21),AL1(@BLWH,3)
DC AL1(0,0,6,2),AL2(21),AL1(@BLWH,1)
DC AL1(0,0,7,2),AL2(21),AL1(@BLWH,3)
DC AL1(0,0,8,2),AL2(21),AL1(@BLWH,1)
DC AL1(0,0,9,2),AL2(21),AL1(@BLWH,3)
DC AL1(0,0,10,2),AL2(21),AL1(@BLWH,1)
DC AL1(0,0,11,2),AL2(21),AL1(@BLWH,3)
DC AL1(0,0,12,2),AL2(21),AL1(@BLWH,0)
*
DC X'FF'
***********************************************************************
END TDFLAG
I hope you enjoyed this post... it's somewhat of a relic from the past but clearly demonstrates precision coding, efficiency & fun.
FYI - Old Glory as it should be presented - 50 stars/13 stripes:
