Liren Large Software Subsidy 6/06.iso/b/b077/1.img/SBGL.ZIP/JKZ1.PRG

Text File | 1979-12-31 | 8.5 KB | 510 lines

set talk off
set device to screen
clear
STORE 'Y' TO C
STORE '         ' TO SB1J
STORE '        ' TO SB11R
STORE '        ' TO SB12R
STORE '        ' TO SB10R
STORE '  ' TO SB24R
STORE '  ' TO SB28R
*USE SM
*GOTO BOTT
STORE '          ' TO SM2J
STORE '          ' TO SM3J
STORE '          ' TO SM4J
STORE '          ' TO SM5J
USE SB INDEX SB1
DO WHILE .NOT. C='N'
APPEND BLANK
CLEAR
STORE 'N' TO CD
DO WHILE CD='N'
CLEAR
@ 0,8 SAY '╔Φ▒╕▒α║┼' GET SB1J
@ 0,40 SAY '╣ñ╥╡╞╒▓Θ║┼' GET SB2
@ 1,8  SAY '╔Φ▒╕├√│╞' GET SB3
@ 1,40 SAY '╨═║┼' GET SB4
@ 2,8  SAY '╣µ╕±' GET SB5
@ 2,40 SAY '╓╪┴┐' GET SB6
@ 3,8 SAY '═Γ╨╬│▀┤τ' GET SB7
@ 3,40 SAY '╓╞╘∞│º' GET SB8
@ 4,8  SAY '╓╞╘∞║┼' GET SB9
@ 4,40 SAY '│÷│º╚╒╞┌' GET SB10R PICT '99.99.99'
@ 5,8  SAY '╚δ┐Γ╚╒╞┌' GET SB11R PICT '99.99.99'
@ 5,40 SAY '╞⌠╙├╚╒╞┌' GET SB12R PICT '99.99.99'
@ 6,8  SAY '╗·F' GET SB13
@ 6,40 SAY '╡τF' GET SB14
@ 7,8  SAY '╡≈╤╨╖╤' GET SM2J PICT '#######.##'
@ 7,40  SAY '╔Φ╝╞╖╤' GET SM3J PICT "#######.##"
@ 8,8  SAY '╣║╓├(╓╞╘∞)╖╤' GET SM4J PICT "#######.##"
@ 8,40 SAY '░▓╫░╡≈╩╘╖╤' GET SM5J PICT "#######.##"
@ 9,8  SAY '╒█╛╔─Ω╧▐' GET SB16
@ 9,40 SAY '╡τ╗·╩²┴┐' GET SB20
READ
CLEAR
@ 0,8  SAY '╓≈╡τ╗·╚▌┴┐' GET SB21
@ 0,40 SAY '╫▄╣ª┬╩' GET SB22
@ 1,8  SAY '╓≈╢»┴ª╘┤' GET SB23
@ 1,40 SAY '╛╗▓╨╓╡┬╩' GET SB26
@ 2,8  SAY '░▓╫░╡╪╡π' GET SB29
READ
STORE SUBS(SB10R,4,2) TO SB10R1
STORE SUBS(SB10R,7,2) TO SB10R2
STORE SUBS(SB10R,1,2) TO SB10R3
STORE SB10R1+'/'+SB10R2+'/'+SB10R3 TO SB10R4
STORE CTOD(SB10R4) TO SB10R5
REPL SB10 WITH SB10R5
STORE SUBS(SB11R,1,2) TO BS1
STORE SUBS(SB11R,4,2) TO BS2
STORE SUBS(SB11R,7,2) TO BS3
STORE BS2+'/'+BS3+'/'+BS1 TO BS4
STORE CTOD(BS4) TO BS5
REPL SB11 WITH BS5
STORE SUBS(SB12R,1,2) TO BS6
STORE SUBS(SB12R,4,2) TO BS7
STORE SUBS(SB12R,7,2) TO BS8
STORE BS7+'/'+BS8+'/'+BS6 TO BS9
STORE CTOD(BS9) TO BS10
REPL SB12 WITH BS10
@ 9,30 SAY '╩Σ╚δ╒²╚╖┬≡?(Y/N)' GET CD
READ
ENDDO
CLEAR
STORE 'N' TO CD
DO WHILE CD='N'
@ 1,5 SAY '╔Φ▒╕└α╩⌠║┼' GET SB24
READ
IF SUBS(SB24,1,1)='H'
USE LS
@ 2,30 CLEAR
STORE 'N' TO B
STORE 1 TO M
DO WHILE .NOT. EOF().AND.B='N'
STORE 2 TO N
STORE 1 TO P
DO WHILE N<=6.AND.(.NOT.EOF())
@ N,30 SAY '('+STR(P,1)+')'
@ N,35 SAY '└α╩⌠┤·║┼  '+LS1
@ N,50 SAY '└α╩⌠├√│╞  '+LS2
STORE P+1 TO P
@ N+1,30 CLEAR
SKIP
STORE N+1 TO N
ENDDO
SET CONS OFF
WAIT ' ' TO B1
SET CONS ON
IF B1=','
STORE M-1 TO M
IF M>0
SKIP -5*2
ELSE
SKIP -6
STORE M+1 TO M
ENDIF
STORE 'N' TO B
ELSE
IF B1='1'
SKIP -5
STORE LS1 TO Q
USE SB
GOTO BOTT
REPL SB24 WITH Q
STORE 'Y' TO B
ELSE
IF B1='2'
SKIP -4
STORE LS1 TO Q
USE SB index sb1
GOTO BOTT
REPL SB24 WITH Q
STORE 'Y' TO B
ELSE
IF B1='3'
SKIP -3
STORE LS1 TO Q
USE SB index sb1
GO BOTT
REPL SB24 WITH Q
STORE 'Y' TO B
ELSE
IF B1='4'
SKIP -2
STORE LS1 TO Q
USE SB index sb1
GO BOTT
REPL SB24 WITH Q
STORE 'Y' TO B
ELSE
IF B1='5'
SKIP -1
STORE LS1 TO Q
USE SB index sb1
GOTO BOTT
REPL SB24 WITH Q
STORE 'Y' TO B
ELSE
IF B1='.'
IF EOF()
SKIP -1
ENDIF
STORE 'N' TO B
STORE M+1 TO M
ELSE
IF B1='R'
STORE 'Y' TO B
ELSE
? CHR(7)
SKIP -5
STORE 'N' TO B
ENDIF
ENDIF
ENDIF
ENDIF
ENDIF
ENDIF
ENDIF
ENDIF
ENDDO
@ 2,30 CLEAR
USE SB index sb1
GOTO BOTT
@ 1,5 SAY '╔Φ▒╕└α╩⌠║┼' GET SB24
ENDIF
@ 2,5 SAY '╣▄╩⌠║┼' GET SB25
READ
IF SUBS(SB25,1,1)="H"
USE GS
@ 2,30 CLEAR
STORE 'N' TO B
STORE 1 TO M
DO WHILE .NOT. EOF().AND.B='N'
STORE 2 TO N
STORE 1 TO P
DO WHILE N<=6.AND.(.NOT.EOF())
@ N,30 SAY '('+STR(P,1)+')'
@ N,35 SAY '╣▄╩⌠┤·┬δ  '+GS1
@ N,50 SAY '╣▄╩⌠├√│╞  '+GS2
STORE P+1 TO P
@ N+1,30 CLEAR
SKIP
STORE N+1 TO N
ENDDO
SET CONS OFF
WAIT ' ' TO B1
SET CONS ON
IF B1=','
STORE M-1 TO M
IF M>0
SKIP -5*2
ELSE
SKIP -6
STORE M+1 TO M
ENDIF
STORE 'N' TO B
ELSE
IF B1='1'
SKIP -5
STORE GS1 TO Q
USE SB index sb1
GO BOTT
REPL SB25 WITH Q
STORE 'Y' TO B
ELSE
IF B1='2'
SKIP -4
STORE GS1 TO Q
USE SB index sb1
GOTO BOTT
REPLA SB25 WITH Q
STORE 'Y' TO B
IF B1='3'
SKIP -3
STORE GS1 TO Q
USE SB index sb1
GOTO BOTT
REPL SB25 WITH Q
ELSE
IF B1='4'
SKIP -2
STORE GS1 TO Q
USE SB index sb1
GOTO BOTT
REPL SB25 WITH Q
STORE 'Y' TO B
ELSE
IF B1='5'
SKIP -1
STORE GS1 TO Q
USE SB index sb1
GOTO BOTT
REPL SB25 WITH Q
STORE 'Y' TO B
ELSE
IF B1='.'
IF EOF()
SKIP -1
ENDIF
STORE 'N' TO B
STORE M+1 TO M
ELSE
IF B1='R'
STORE 'Y' TO B
ELSE
? CHR(7)
SKIP -5
STORE 'N' TO B
ENDIF
ENDIF
ENDIF
ENDIF
ENDIF
ENDIF
ENDIF
ENDIF
ENDDO
@ 3,30 CLEAR
USE SB index sb1
GOTO BOTT
@ 3,5 SAY '╣▄╩⌠║┼' GET SB25
ENDIF
@ 3,5 SAY '╓╪╥¬│╠╢╚' GET SB27
@ 4,5 SAY '╩╣╙├╡Ñ╬╗▒α║┼' GET SB28
READ
IF SUBS(SB28,1,1)='H'
USE DW
@ 2,30 CLEAR
STORE 'N' TO B
STORE 1 TO M
DO WHILE .NOT. EOF().AND.B='N'
STORE 2 TO N
STORE 1 TO P
DO WHILE N<=6.AND.(.NOT.EOF())
@ N,30 SAY '('+STR(P,1)+')'
@ N,36 SAY '╡Ñ╬╗┤·┬δ  '+DW1
@ N,52 SAY '╡Ñ╬╗├√│╞  '+DW2
STORE P+1 TO P
@ N+1 ,30 CLEAR
SKIP
STORE N+1 TO N
ENDDO
SET CONS OFF
WAIT ' ' TO B1
SET CONS ON
IF B1=','
STORE M-1 TO M
IF M>0
SKIP -5*2
ELSE
SKIP -6
STORE M+1 TO M
ENDIF
STORE 'N' TO B
ELSE
IF B1='1'
SKIP -5
STORE DW1 TO Q
USE SB index sb1
GO BOTT
REPL SB28 WITH Q
STORE 'Y' TO B
ELSE
IF B1='2'
SKIP -4
STORE DW1 TO Q
USE SB index sb1
GO BOTT
REPL SB28 WITH Q
STORE 'Y' TO B
ELSE
IF B1='3'
SKIP -3
STORE DW1 TO Q
USE SB index sb1
GO BOTT
REPL SB28 WITH Q
STORE 'Y' TO B
ELSE
IF B1='4'
SKIP -2
STORE DW1 TO Q
USE SB index sb1
GO BOTT
REPL SB28 WITH Q
STORE 'Y' TO B
ELSE
IF B1='5'
SKIP -1
STORE DW1 TO Q
USE SB index sb1
GOTO BOTT
REPL SB28 WITH Q
STORE 'Y' TO B
ELSE
IF B1='.'
IF EOF()
SKIP -1
ENDIF
STORE 'N' TO B
STORE M+1 TO M
ELSE
IF B1='R'
STORE 'Y' TO B
ELSE
? CHR(7)
SKIP -5
STORE 'N' TO B
ENDIF
ENDIF
ENDIF
ENDIF
ENDIF
ENDIF
ENDIF
ENDIF
ENDDO
@ 1,30 CLEAR
USE SB index sb1
GOTO BOTT
@ 4,5 SAY '╩╣╙├╡Ñ╬╗▒α║┼' GET SB28
ENDIF
@ 1,25 CLEAR
@ 1,25 SAY '╛▓├▄╖Γ╡π╩²' GET SB35
@ 1,50 SAY '╢»├▄╖Γ╡π╩²' GET SB36
@ 2,25 SAY '╧╨╓├╖±(X)' GET SB31
READ
@ 7,25 SAY '╩Σ╚δ╒²╚╖┬≡?(Y/N)' GET CD
READ
STORE UPPE(CD) TO CD
ENDDO
STORE VAL(SM2J) TO SM2R
STORE VAL(SM3J) TO SM3R
SM4R=VAL(SM4J)
STORE VAL(SM5J) TO SM5R
STORE SM2R+SM3R+SM4R+SM5R TO SB15J
REPL SB15 WITH SB15J
REPL SB1 WITH SB1J
STORE DTOC(SB12) TO SB12R1
STORE SUBS(SB12R1,7,2) TO SB12R2
STORE SUBS(SB12R1,1,2) TO SB12R3
STORE 12-VAL(SB12R3) TO SB12R4
IF VAL(SB12R2)<87
STORE SB15*0.042*(86-VAL(SB12R2)+0.5)+SB15*0.5*(1-SB26)/SB16 TO SB18R1
STORE SB15*0.042*SB12R4*1/12 TO SB18R2
REPL SB18 WITH SB18R1+SB18R2
REPL SB17 WITH (SB15-SB18)
ENDIF
IF VAL(SB12R2)=87
IF SB12R4>6
STORE SB15*0.042*(SB12R4-6)*1/12 TO SB18R1
STORE SB15*(1-SB26)/SB16*6*1/12 TO SB18R2
REPL SB18 WITH SB18R1+SB18R2
REPL SB17 WITH SB15-SB18
ELSE
STORE SB15*(1-SB26)/SB16*SB12R4*1/12 TO SB18R2
REPL SB18 WITH SB18R2
REPL SB17 WITH SB15-SB18
ENDIF
ENDIF
IF VAL(SB12R2)>87
REPL SB18 WITH 0
REPL SB17 WITH SB15
ENDIF
STORE ' ' TO A
@ 8,5 SAY '╩╟╖±╢╘┤╦╔Φ▒╕╜°╨╨╩┘├ⁿ╓▄╞┌╖╤╙├╖╓╬÷?(Y/N)' GET A
READ
STORE UPPE(A) TO A
IF A='Y'
USE SM
APPEND BLANK
REPL SM1 WITH SB1J
REPL SM2 WITH SM2R
REPL SM3 WITH SM3R
REPL SM4 WITH SM4R
REPL SM5 WITH SM5R
ENDIF
USE SB index sb1
GOTO BOTT
STORE SB24 TO SB24R
STORE SB28 TO SB28R
STORE SB4 TO SB4R
USE TJ
SET EXACT ON
LOCAT FOR TJ1=SB28R .AND.TJ2=SB24R
IF EOF()
APPE BLANK
REPL TJ1 WITH SB28R,TJ2 WITH SB24R
REPL TJ3 WITH 1
ELSE
REPL TJ3 WITH TJ3+1
ENDIF
USE ZC
CLEAR
STORE 'Y' TO X
@ 2,25 SAY '┤╦╠¿╔Φ▒╕╤Θ╩╒║≤╩╟╖±╥¬╢╘╔Φ▒╕╘▌┤µ┐Γ╜°╨╨╡≈╒√' GET X
READ
IF X='Y'
STORE '         ' TO E
@ 4,25 SAY '╟δ╩Σ╚δ╔Φ▒╕╢⌐╗⌡║╧═¼║┼' GET E
READ
SET EXACT ON
LOCAT FOR ZC4=SB4R .AND. ZC1=E
IF ZC4=SB4R .AND. ZC1=E
REPL ZC6 WITH ZC6-1
IF ZC6=0
DELE
PACK
ENDIF
ENDIF
ENDIF
STORE '         ' TO SB1J
STORE '        ' TO SB11R
STORE '        ' TO SB12R
USE SB index sb1
@ 9,25 SAY '╗╣╝╠╨°╩Σ╚δ┬≡?' GET C
READ
STORE UPPE(C) TO C
IF C='N'
CLEAR
STORE 'Y' TO F
@ 3,25 SAY '╥¬┴⌠▒╕╖▌┬≡?(Y/N)' GET F
READ
STORE UPPE(F) TO F
IF F='Y'
GOTO BOTT
IF RECNO()>950
@ 4,25 SAY '╟δ╫╝▒╕║├┴╜╒┼╔Φ▒╕┐Γ╚φ┼╠'
@ 5,25 SAY '╟δ▓σ╚δ╡┌╥╗╒┼╚φ┼╠'
@ 6,25 SAY '╖┼║├║≤░┤╚╬║╬╝ⁿ╝┤┐╔'
WAIT '   '
COPY ALL FOR RECNO<=950 TO A:SB
@ 7,25 SAY '╡┌╥╗╒┼┼╠┐╜▒┤═Ω▒╧'
@ 8,25 SAY '╟δ▓σ╚δ╡┌╢■╒┼╚φ┼╠'
@ 9,25 SAY '╖┼║├║≤╟δ░┤╚╬║╬╝ⁿ'
SM4R=VAL(SM4J)
WAIT '    '
COPY ALL FOR RECNO>950 TO A:SB
ELSE
@ 8,25 SAY '╟δ▓σ╚δ▒╕╖▌╚φ┼╠'
@ 9,25 SAY '╖┼║├║≤░┤╚╬║╬╝ⁿ'
WAIT '     '
COPY ALL TO A:SB
ENDIF
USE TJ
CLEAR
@ 4,25 SAY '╟δ▓σ╚δ═│╝╞╚φ┼╠'
@ 5,25 SAY '╫╝▒╕║├║≤╟δ░┤╚╬╥Γ╝ⁿ'
WAIT '   '
COPY ALL TO A:TJ
USE SM
CLEAR
@ 4,25 SAY '╟δ▓σ╚δ╩┘├ⁿ╖╤╙├╖╓╬÷╚φ┼╠'
@ 5,25 SAY '╫╝▒╕║├║≤╟δ░┤╚╬╥Γ╝ⁿ'
WAIT '   '
COPY ALL TO A:SM
ENDIF
ENDIF
ENDDO
RETURN