DataMuseum.dk

top - metrics - download

    Length: 4603 (0x11fb)
    Types: SPC/1-COMAL-80
    Notes: Mikados_B, UNKNOWN_TOKEN_00, UNKNOWN_TOKEN_cd
    Names: »ÅRSOP85«

└─⟦fe8d363bb⟧ Bits:30004640 EASY-Skat 1985 (MIKADOS)
    └─⟦this⟧ »ÅRSOP85« 

SPC/1 COMAL-80

00100 ON ESC GOTO DUMMY
00110 INTEGER X , N , PR , Y , F8 , FE , G , T0 , T1 , T2 , T3 , T4
00120 LET STATUS := 0 ; G1 := 0 ; B7 := 0 ; B8 := 0 ; U2 := 0 ; F0 := 0 ; F7 := 0 ; T3 := 0 ; T := 0 ; T0 := 0
00130 LET TKB := 0 ; TKH := 0
00140 DIM A1 $ ( 29 ) OF 29 , A ( 29 ) , H ( 23 ) , K ( 23 ) , LI $ OF 80 , QT $ OF 80 , S $ OF 80
00150 DIM FIL $ OF 15 , PIL $ OF 80 , SP $ OF 80 , HKL $ OF 38 , BKL $ OF 38
00160 LET LI $ := "" ; PIL $ := "" ; SP $ := ""
00170 FOR X := 1 TO 8 DO
00180 LET LI $ := LI $ + "-" ; PIL $ := PIL $ + "." ; SP $ := SP $ + "…"
00190 NEXT X
00200 LET F8 := 0 ; G := 0 ; T2 := 2 ; T4 := 0
00210 LET FIL $ := "dde:skatsys"
00220 OPEN FIL $ , R
00230 GET FIL $ : SYS
00240 CLOSE FIL $
00250 OPEN FIL $ , W
00260 LET SYS := 1
00270 PUT FIL $ : SYS
00280 CLOSE FIL $
00290 LET FIL $ := "dde:hskvar"
00300 OPEN FIL $ , R
00310 FOR X := 1 TO 9 DO
00320 GET FIL $ : A ( X )
00330 IF X < 24 THEN GET FIL $ : H ( X ) , K ( X )
00340 NEXT X
00350 GET FIL $ : F8 , T1 , T2 , T4
00360 CLOSE FIL $
00370 LET FIL $ := "dde:fvar"
00380 OPEN FIL $ , R
00390 GET FIL $ : PR , C4 , HD6 , C9 , B0 , T1 , TKH , F6 , F1
00400 GET FIL $ : F9 , P1 , P7 , P8 , P9 , T0 , B2 , B1 , B9
00410 GET FIL $ : T2 , C6 , BD6 , C0 , B3 , E6 , F2 , T3 , TKB
00420 GET FIL $ : F0 , F7 , SKG , AKT , D6 , GSLUT
00430 GET FIL $ : HFORMUE , BFORMUE , HATP , BATP , G , FSLUT
00440 GET FIL $ : HKL $ , BKL $
00450 CLOSE FIL $
00460 LET X := 0
00470 OPEN "dde:skatart" , R
00480 REPEAT
00490 LET X := X + 1
00500 GET "dde:skatart" : A1 $ ( X )
00510 UNTIL ╱cd╱ ( "dde:skatart" ) = 19 OR ╱cd╱ ( "dde:skatart" ) > 0 OR X = 29
00520 CLOSE
00530 LET E1 := 28 ; F3 := 64000 ; F4 := 70999 ; F5 := 1985 ; P1 := 111300 ; P2 := 182600
00540 LET P3 := 22700 ; P4 := 20300 ; P5 := 43900 ; P6 := 24000 ; P0 := 3.5 ; PA0 := 2
00550 LET U1 := .9 ; U2 := 1229200 ; M1 := 112700
00560 LET D6 := HD6 ; SKG := F6 ; AKT := F9
00570 FOR X := 24 TO 9 DO
00580 LET A ( X ) := 0
00590 NEXT X
00600 IF >< 1 AND GSLUT >< 1 THEN
00610 LET FIL $ := "dde:skatsluh"
00620 OPEN FIL $ , R
00630 EXEC L[SF
00640 EXEC GEMHOP
00650 ELSE
00660 EXEC HENTHOP
00670 ENDIF
00680 FOR Y := 1 TO R + 1 DO
00690 IF Y = 2 THEN OUTPUT "p"
00700 IF = 2 THEN
00710 EXEC TLI
00720 ELSE
00730 CLEAR
00740 ENDIF
00750 LET QT $ := "]RSOPG\RELSE…FOR…" + HKL $ + ":"
00760 EXEC LSKRIV3
00770 EXEC ]RSOPG
00780 IF Y = 1 THEN EXEC RETURN
00790 IF Y = 2 THEN OUTPUT "t"
00800 NEXT Y
00810 IF 2 >< 0 THEN
00820 LET D6 := BD6 ; SKG := F7 ; AKT := F0
00830 FOR X := 24 TO 9 DO
00840 LET A ( X ) := 0
00850 NEXT X
00860 CLEAR
00870 IF >< 1 AND GSLUT >< 1 THEN
00880 LET FIL $ := "dde:skatslub"
00890 OPEN FIL $ , R
00900 EXEC L[SF
00910 EXEC GEMBIP
00920 ELSE
00930 EXEC HENTBIP
00940 ENDIF
00950 FOR Y := 1 TO R + 1 DO
00960 IF Y = 2 THEN OUTPUT "p"
00970 IF = 2 THEN
00980 EXEC TLI
00990 ELSE
01000 CLEAR
01010 ENDIF
01020 LET QT $ := "]RSOPG\RELSE…FOR…" + BKL $ + ":"
01030 EXEC LSKRIV3
01040 EXEC ]RSOPG
01050 IF Y = 1 THEN EXEC RETURN
01060 IF Y = 2 THEN OUTPUT "t"
01070 NEXT Y
01080 ENDIF
01090 PRINT "***…VENT…***…HOVEDPROGRAMMET…INDL[SES…***"
01100 CHAIN "DDE:SKAT85"
01110 PROC LSKRIV2
01120 LET PRB := QB
01130 PRINT QT $ ;
01140 PRINT USING "#########.##…KR." : PRB
01150 ENDPROC LSKRIV2
01160 PROC LSKRIV1
01170 LET PRB := QB
01180 PRINT QT $ ;
01190 PRINT USING "#########…KR." : PRB
01200 ENDPROC LSKRIV1
01210 PROC LSKRIV4
01220 LET PRB := QB
01230 PRINT QT $ ;
01240 PRINT USING "#########…PCT." : PRB
01250 ENDPROC LSKRIV4
01260 PROC SVAR
01270 REPEAT
01280 INPUT S $
01290 IF $ = "q" OR S $ = "Q" THEN
01300 PRINT "Programmet…kan…kun…afsluttes…fra…hovedprogrammet." ; CHR$ ( 7 )
01310 ENDIF
01320 UNTIL S $ = "j" OR S $ = "n"
01330 PRINT LI $
01340 ENDPROC SVAR
01350 PROC LSKRIV
01360 PRINT
01370 ENDPROC LSKRIV
01380 PROC LSKRIV3
01390 PRINT QT $
01400 ENDPROC LSKRIV3
01410 PROC ]RSOPG
01420 IF Y = 1 THEN LET DD6 := D6
01430 LET A ( 27 ) := SKG + AKT
01440 PRINT
01450 LET QT $ := "SLUTSKAT" + PIL $ ( 1 : 23 ) ; QB := INT ( D6 )
01460 EXEC LSKRIV1
01470 FOR X := 24 TO 9 DO
01480 IF ( X ) > 0 AND X >< 28 AND X >< 29 THEN
01490 IF = 1 THEN
01500 LET D6 := D6 - A ( X )
01510 ENDIF
01520 PRINT "-…" ;
01530 ENDIF
01540 IF ( X ) > 0 AND ( X = 28 OR X = 29 ) THEN
01550 IF = 1 THEN
01560 LET D6 := D6 + A ( X )
01570 ENDIF
01580 PRINT "+…" ;
01590 ENDIF
01600 IF ( X ) > 0 THEN
01610 LET QT $ := A1 $ ( X ) ; QB := A ( X )
01620 EXEC LSKRIV1
01630 ENDIF
01640 NEXT X
01650 LET QT $ := SP $ ( 1 : 32 ) + "------------"
01660 EXEC LSKRIV3
01670 IF ( D6 ) > 0 THEN
01680 LET QT $ := "RESTSKAT" + PIL $ ( 1 : 23 ) ; QB := INT ( D6 )
01690 EXEC LSKRIV1
01700 ENDIF
01710 IF ( D6 ) = 0 THEN
01720 LET QT $ := "FORSKUDSSKATTEN…STEMMER…MED…SLUTSKATTEN."
01730 EXEC LSKRIV3
01740 ENDIF
01750 IF ( D6 ) < 0 THEN
01760 LET QT $ := "OVERSKYDENDE…SKAT" + PIL $ ( 1 : 14 ) ; QB := INT ( D6 )
01770 EXEC LSKRIV1
01780 ENDIF
01790 IF ( D6 ) >< 0 THEN
01800 LET QT $ := SP $ ( 1 : 32 ) + "============"
01810 EXEC LSKRIV3
01820 ENDIF
01830 IF ( 21 ) > 0 THEN
01840 LET QT $ := "P}lignet…B-skat…foruds{ttes…betalt."
01850 EXEC LSKRIV3
01860 ENDIF
01870 ENDPROC ]RSOPG
01880 PROC L[SF
01890 FOR X := 24 TO 9 DO
01900 IF >< 27 THEN
01910 IF ( FIL $ ) = 0 THEN
01920 GET FIL $ : S $
01930 PRINT S $
01940 GET FIL $ : S $
01950 PRINT S $ ;
01960 INPUT "" : A ( X )
01970 PRINT LI $
01980 ENDIF
01990 ENDIF
02000 NEXT X
02010 CLEAR
02020 ENDPROC L[SF
02030 PROC RETURN
02040 LET S $ := "-"
02050 PRINT
02060 PRINT TAB ( 65 ) ;
02070 EDIT "TRYK…-RETURN" : S $
02080 ENDPROC RETURN
02090 PROC TLI
02100 FOR X := 1 TO DO
02110 PRINT
02120 NEXT X
02130 ENDPROC TLI
02140 PROC GEMHOP
02150 OPEN "DDE:HSLUT" , W
02160 FOR X := 1 TO DO
02170 IF X >< 3 THEN PUT "DDE:HSLUT" : A ( 30 - X )
02180 NEXT X
02190 CLOSE "DDE:HSLUT"
02200 ENDPROC GEMHOP
02210 PROC GEMBIP
02220 OPEN "DDE:BSLUT" , W
02230 FOR X := 1 TO DO
02240 IF X >< 3 THEN PUT "DDE:BSLUT" : A ( 30 - X )
02250 NEXT X
02260 CLOSE "DDE:BSLUT"
02270 ENDPROC GEMBIP
02280 PROC HENTHOP
02290 OPEN "DDE:HSLUT" , R
02300 FOR X := 1 TO DO
02310 IF X >< 3 THEN GET "DDE:HSLUT" : A ( 30 - X )
02320 NEXT X
02330 CLOSE "DDE:HSLUT"
02340 ENDPROC HENTHOP
02350 PROC HENTBIP
02360 OPEN "DDE:BSLUT" , R
02370 FOR X := 1 TO DO
02380 IF X >< 3 THEN GET "DDE:BSLUT" : A ( 30 - X )
02390 NEXT X
02400 CLOSE "DDE:BSLUT"
02410 ENDPROC HENTBIP
01760 LET QT $ := "OVERSKYDENDE…SKAT" + PIL $ ( 1 : 14 ) ; QB := ABS ( D6 )
00455 STOP
00455
00455 LET HD6 := HD6 + B9 ; BD6 := BD6 + E6
00560 LET D6 := HD6 + B9 ; SKG := F6 ; AKT := F9
00820 LET D6 := BD6 + E6 ; SKG := F7 ; AKT := F0
00685 LET MIDD6 := D6
00795 LET D6 := MIDD6
01680 LET QT $ := "RESTSKAT" + PIL $ ( 1 : 23 ) ; QB := INT ( DD6 )
01680 LET QT $ := "RESTSKAT" + PIL $ ( 1 : 23 ) ; QB := INT ( D6 )
01450 LET QT $ := "SLUTSKAT" + PIL $ ( 1 : 23 ) ; QB := INT ( DD6 )
38382 ╱00╱ ╱00╱