Galaxis: A Calendar and Encrypting Program (GFA Basic, Amiga)
%2Fused%2Fgalaxis.jpg&w=3840&q=75 "A look at Galaxis running on my Amiga")
A look at Galaxis running on my AmigaGalaxis was a kind of calendar and encrypting program I wrote in GFA Basic on Commodore Amiga.
REM ---------------------------------------------------------------------------
REM THE NEW VERSION OF g a l a x i s
REM TOMAS J. FULOPP in POPRAD, SLOVAKIA, JUNE 1993 (PHONE +42 - (0)92 - 32814)
REM GALAXIS WAS UPDATED ALL THE TIME, BUT RADICALLY IN FEBRUARY 1994
REM MAJOR UPDATE OF CHESTER ENCRYPTER & SETMAP TRANSFORMERS ADD IN MARCH 3, 1995
REM ---------------------------------------------------------------------------
REM up 155 65, down 155 66, right 155 67, left 155 68
REM Sun 7.12.1941; Wed 2.10.1872; Sat 21.12.1872; Sun 22.10.1944
REM ---------------------------------------------------------------------------
REM !!! ADD, SUB, MUL, DIV, PRED, SUCC ... pracuju len s celociselnymi operandami !!!
RESERVE 500000
REM OPENS 1,0,0,640,512,4,32772
REM OPENS 1,0,0,640,256,4,32768
REM ked nieco nepojde, pozriet sa na toto zadanie okna; velmi dolezite
REM OPENW #1,0,0,320,256,0,1+16+32+2+4+8+0+4096
REM OPENW #1,0,0,640,512,0,1+16+32+2+4+8+0+4096
REM OPENW #1,0,0,640,256,0,2048
OPENW #1
FULLW #1
svet%=2147483647
maxpocetitemov&=7000
DIM menu$(43)
DIM datumcislo%(maxpocetitemov&)
DIM itemfirst%(maxpocetitemov&)
DIM d$(7)
DIM m&(12)
DIM tesla|(2023)
DIM slava$(maxpocetitemov&)
DIM sorted$(maxpocetitemov&)
DIM adresa$(maxpocetitemov&)
DIM riadok$(maxpocetitemov&)
DIM alarm$(255)
DIM amessage$(255)
REM Nasledujuci DIM pass|(255) je tu kvoli CHESTER koderu
DIM pass|(255)
REM DIM john|(90) je tu kvoli transformatorom !
DIM john|(90)
annual!=TRUE
REM --------------------------------
REM ako vztazny den je dany PONDELOK 14.6.1993 (24 tyzden (western model)):
etalonday&=14
etalonmonth&=6
etalonyear%=1993
bbetalon%=727743
betalon&=1
REM --------------------------------
actualdate
menu$(0)="CALENDAR "
menu$(1)="DATE "
menu$(2)="!CURRENT DATE "
menu$(3)="!INSERT NEW DATE "
menu$(4)="SORT FILE "
menu$(5)="!DAYS FROM NOW "
menu$(6)="!MONTHS FROM NOW "
menu$(7)="!YEARS FROM NOW "
menu$(8)="! ANNUAL ITEMS"
menu$(9)="QUIT "
menu$(10)=""
menu$(11)="FILES "
menu$(12)="PLATYS"
menu$(13)="!EDIT ADDRESSES.PBX "
menu$(14)="!EDIT SORTEDPLATYS.PBX"
menu$(15)="NOTES"
menu$(16)="!EDIT NOTES.PBX "
menu$(17)="ADDRESSES"
menu$(18)="!EDIT ADDRESSES.PBX "
menu$(19)="!FIND ADDRESSES "
menu$(20)="!FIND TODAYS ADDRESSES "
menu$(21)="!EDIT SORTEDADDRESSES "
menu$(22)="LITERATURE"
menu$(23)="!EDIT LITERATURE.PBX "
menu$(24)="!BOOK PROCESSOR "
menu$(25)=""
menu$(26)="OTHERS "
menu$(27)="SOLAR SYSTEM "
menu$(28)="CHESTER CODER "
menu$(29)="MESSAGE ALARM "
menu$(30)=""
menu$(31)="TRANSFORMERS "
menu$(32)="TOM --> TRANS"
menu$(33)="TRANS --> TOM"
menu$(34)="TOM --> KOI"
menu$(35)="KOI --> TOM"
menu$(36)="TOM --> TWIG"
menu$(37)="TWIG --> TOM"
menu$(38)="PBX --> KOI"
menu$(39)="KOI --> PBX"
menu$(40)="PBX --> TRANS"
menu$(41)="TRANS --> PBX"
menu$(42)=""
menu$(43)=""
MENU menu$()
MENU KEY 2,ASC("C")
MENU KEY 3,ASC("I")
MENU KEY 5,ASC("D")
MENU KEY 6,ASC("M")
MENU KEY 7,ASC("Y")
MENU 8,16+64+256
MENU KEY 9,ASC("Q")
MENU KEY 13,ASC("P")
MENU KEY 16,ASC("N")
MENU KEY 18,ASC("A")
MENU KEY 19,ASC("F")
MENU KEY 20,ASC("T")
MENU KEY 23,ASC("L")
MENU KEY 24,ASC("B")
MENU KEY 27,ASC("S")
MENU KEY 28,ASC("H")
MENU KEY 29,ASC("R")
ON MENU GOSUB menu
weekday
currentdateonscreen
currentitemonscreen
DO
FOR budi|=1 TO budikov|
IF TIME$=alarm$(budi|) OR TIME$=LEFT$(alarm$(budi|),5)+":07"
FRONTS 1
CLS
currentdateonscreen
PRINT AT(6,6);"(";budi|;".) ";alarm$(budi|);" ";amessage$(budi|)
PRINT AT(16,28);"### HIT SPACE TO CONFIRM ###"
WHILE INKEY$=""
WEND
CLS
weekday
currentdateonscreen
currentitemonscreen
BACKS 1
ENDIF
NEXT budi|
currentdateonscreen
ink$=INKEY$
IF ASC(LEFT$(ink$))=155 AND ASC(RIGHT$(ink$))=68
REM DOLAVA
IF day&>1
DEC day&
ELSE
IF FRAC(year%/4)=0 AND month&=3 AND day&=1
day&=29
month&=2
ELSE IF month&=1 AND day&=1
IF year%>1
day&=31
month&=12
DEC year%
ENDIF
ELSE IF day&=1
DEC month&
day&=m&(month&)
ENDIF
ENDIF
CLS
weekday
currentdateonscreen
currentitemonscreen
ELSE IF ASC(LEFT$(ink$))=155 AND ASC(RIGHT$(ink$))=67
REM DOPRAVA
IF FRAC(year%/4)=0 AND month&=2 AND day&=28
day&=29
ELSE IF day&=31 AND month&=12
IF year%<svet%
day&=1
month&=1
INC year%
ENDIF
ELSE IF day&=m&(month&)
day&=1
INC month&
ELSE IF day&<m&(month&)
INC day&
ENDIF
CLS
weekday
currentdateonscreen
currentitemonscreen
ENDIF
ON MENU
PRINT AT(6,28);"*** ARROWS <-- --> DE/INCREASE THE DATE ***"
LOOP
REM ---------------------------------------------------------------------------
REM ---------------------------------------------------------------------------
REM ZA TYMTO RIADKOM BUDU SPOCIVAT VSETKY PROCEDURY
REM ---------------------------------------------------------------------------
PROCEDURE menu
agfa&=MENU(0)
SELECT agfa&
CASE 2
REM CURRENT DATE
actualdate
CLS
weekday
currentdateonscreen
currentitemonscreen
CASE 3
REM INSERT NEW DATE
CLS
PRINT AT(9,22);"LEAVE BLANK TO SET CURRENT DATE"
PRINT AT(9,10);"ENTER DAY....... ";
FORM INPUT 2,day$
PRINT AT(9,11);"ENTER MONTH..... ";
FORM INPUT 2,month$
PRINT AT(9,12);"ENTER YEAR...... ";
FORM INPUT 10,year$
IF day$=""
day&=VAL(LEFT$(DATE$,2))
ELSE
day&=VAL(day$)
ENDIF
IF month$=""
month&=VAL(MID$(DATE$,4,2))
ELSE
month&=VAL(month$)
ENDIF
IF year$=""
year%=VAL(RIGHT$(DATE$,4))
ELSE
year%=VAL(year$)
ENDIF
CLS
weekday
currentdateonscreen
currentitemonscreen
CASE 5
REM SORT ADDRESSES.PBX DAYS FROM NOW
esav:
CLS
PRINT AT(9,10);
INPUT "ENTER NUMBER OF DAYS TO SHOW: ",numb%
CLR ano|
IF FRAC(year%/4)=0
ano|=1
ENDIF
IF numb%<1 OR numb%>ADD(365,ano|)
GOTO esav
ENDIF
TITLEW #1," SORT "+STR$(numb%)+" DAYS AHEAD"
sortsave
CLS
weekday
currentdateonscreen
currentitemonscreen
CASE 6
REM SORT ADDRESSES.PBX MONTHS FROM NOW
esavv:
CLS
PRINT AT(9,10);
INPUT "ENTER NUMBER OF MONTHS TO SHOW: ",numb%
IF numb%<1 OR numb%>12
GOTO esavv
ENDIF
TITLEW #1," SORT "+STR$(numb%)+" MONTHS AHEAD"
REM POCET DNI JE TU RATANY AKO ZE DNI V MESIACI JE 31 (LEPSIE VIAC AKO MENEJ!)
MUL numb%,31
CLR ano|
IF FRAC(year%/4)=0
ano|=1
ENDIF
IF numb%>ADD(365,ano|)
numb%=ADD(365,ano|)
ENDIF
sortsave
CLS
weekday
currentdateonscreen
currentitemonscreen
CASE 7
REM SORT ADDRESSES.PBX YEARS FROM NOW
esavvv:
CLS
PRINT AT(9,10);
INPUT "ENTER NUMBER OF YEARS TO SHOW: ",numb%
IF numb%<1
GOTO esavvv
ENDIF
TITLEW #1," SORT "+STR$(numb%)+" YEARS AHEAD"
REM POCET DNI JE TU RATANY AKO ZE DNI V ROKU JE 366 (LEPSIE VIAC AKO MENEJ!)
MUL numb%,366
sortsave
CLS
weekday
currentdateonscreen
currentitemonscreen
CASE 8
IF annual!=TRUE
MENU 8,16+64
annual!=FALSE
ELSE IF annual!=FALSE
MENU 8,16+64+256
annual!=TRUE
ENDIF
CASE 9
CLOSE
CLOSES 1
EDIT
CASE 13
c!=EXEC("RUN HDW:CYGNUSV3.5 HDW:Super-Data/Words/NOTES/NOTES.PBX",0,0)
CASE 14
c!=EXEC("RUN HDW:CYGNUSV3.5 HDW:Super-Data/Words/NOTES/SORTEDPLATYS.PBX",0,0)
CASE 16
c!=EXEC("RUN HDW:CYGNUSV3.5 HDW:Super-Data/Words/NOTES/NOTES.PBX",0,0)
CASE 18
c!=EXEC("RUN HDW:CYGNUSV3.5 HDW:Super-Data/Words/NOTES/NOTES.PBX",0,0)
CASE 19
TITLEW #1," ADDRESS FIND IS CASE SENSITIVE ! "
CLS
PRINT AT(3,10);
INPUT "ENTER A SIGNIFICANT STRING: ",signi$
CLS
TITLEW #1," ADDRESS FIND - "+signi$
PRINT AT(1,2);
GOTO pokracujeme
CASE 20
CLS
signi$=STR$(day&)+"."+STR$(month&)
TITLEW #1," FIND TODAY'S ADDRESSES - "+signi$
PRINT AT(1,2);
pokracujeme:
OPEN "i",#13,"HDW:Super-Data/Words/NOTES/NOTES.PBX"
IF lofa%=0 OR lofa%<>LOF(#13)
lofa%=LOF(#13)
FOR ax%=1 TO svet%
LINE INPUT #13,adresa$
EXIT IF LEFT$(adresa$,10)=" COLLECTED"
NEXT ax%
FOR ax%=1 TO svet%
LINE INPUT #13,adresa$(ax%)
EXIT IF EOF(#13)
NEXT ax%
ENDIF
CLOSE #13
OPEN "o",#2,"HDW:Super-Data/Words/NOTES/SORTEDADDRESSES.PBX"
CLR as%
DO
INC as%
EXIT IF adresa$(as%)=""
LOOP
zaciatok%=as%
DO
DO
INC as%
REM VYPOTIL SOM KENGURU - JE 3 a.m. - PRIKAZ INSTR MENI HODNOTU LOC(#1) !!!!!!
IF INSTR(adresa$(as%),signi$)<>0
as%=zaciatok%
DO
INC as%
PRINT adresa$(as%)
PRINT #2,adresa$(as%)
EXIT IF adresa$(as%)="" OR as%=ax%
LOOP
ENDIF
EXIT IF adresa$(as%)="" OR as%=ax%
LOOP
EXIT IF as%=ax%
IF adresa$(as%)=""
zaciatok%=as%
ENDIF
LOOP
CLOSE #2
PRINT
PRINT SPC(9);"*** PRESS ANY KEY TO RETURN TO THE MAIN MENU ***"
FRONTS 1
WHILE INKEY$=""
WEND
CLS
currentdateonscreen
currentitemonscreen
CASE 21
c!=EXEC("RUN HDW:CYGNUSV3.5 HDW:Super-Data/Words/NOTES/SORTEDADDRESSES.PBX",0,0)
CASE 23
c!=EXEC("RUN HDW:CYGNUSV3.5 HDW:Super-Data/Words/NOTES/LITERATURE.PBX",0,0)
CASE 24
CLS
TITLEW #1," BOOK PROCESSOR "
OPEN "i",#7,"HDW:Super-Data/Words/NOTES/LITERATURE.PBX"
IF lofb%=0 OR lofb%<>LOF(#7)
lofb%=LOF(#7)
FOR kx%=1 TO svet%
LINE INPUT #7,riadok$(kx%)
EXIT IF EOF(#7)
NEXT kx%
ENDIF
CLOSE #7
CLR aut%
CLR pre%
CLR nep%
PRINT AT(9,4);"THE BOOK PROCESSOR PART OF GALAXIS"
PRINT AT(9,6);"WAS MADE ON FEBRUARY 10, 1994 IN POPRAD"
PRINT AT(9,10);"NUMBER OF AUTHORS: "
PRINT AT(9,12);"NUMBER OF READ BOOKS: "
PRINT AT(9,14);"NUMBER OF UNREAD BOOKS: "
PRINT AT(9,16);"NUMBER OF ALL BOOKS: "
PRINT AT(9,20);"RATIO UNREAD / ALL BOOKS: "
FOR cx%=1 TO kx%
autor&=INSTR(riadok$(cx%),"$")
precitane&=INSTR(riadok$(cx%),"*")
neprecitane&=INSTR(riadok$(cx%),"=")
IF (autor&<>0 AND precitane&<>0) OR (autor&<>0 AND neprecitane&<>0) OR (precitane&<>0 AND neprecitane&<>0)
PRINT
PRINT " FIRST PLEASE SOLVE THIS PROBLEM:"
PRINT
PRINT riadok$(cx%)
WHILE INKEY$=""
WEND
CLOSE
EDIT
ENDIF
IF autor&<>0
INC aut%
ELSE IF precitane&<>0
INC pre%
ELSE IF neprecitane&<>0
INC nep%
ENDIF
PRINT AT(35,10);aut%
PRINT AT(35,12);pre%
PRINT AT(35,14);nep%
PRINT AT(35,16);ADD(pre%,nep%)
IF ADD(pre%,nep%)<>0
PRINT AT(35,20);nep%/((ADD(pre%,nep%))/100);" %";SPC(15)
ENDIF
NEXT cx%
PRINT AT(9,25);"*** PRESS ANY KEY TO RETURN TO THE MAIN MENU ***"
FRONTS 1
WHILE INKEY$=""
WEND
CLS
currentdateonscreen
currentitemonscreen
CASE 27
solarsystem
CLS
weekday
currentdateonscreen
currentitemonscreen
CASE 28
chester
CLS
weekday
currentdateonscreen
currentitemonscreen
CASE 29
budiznova:
budivyskoc!=FALSE
CLS
PRINT AT(6,3);"HOW MANY ALARMS YOU WANT TO KEY IN ? - ";
FORM INPUT 2,budikov$
budikov|=VAL(budikov$)
PRINT
FOR budi|=1 TO budikov|
PRINT
PRINT
PRINT " (";budi|;".) ENTER ALARM TIME....... ";
FORM INPUT 5,alarm$(budi|)
IF MID$(alarm$(budi|),1,1)=" "
MID$(alarm$(budi|),1,1)="0"
ENDIF
IF MID$(alarm$(budi|),2,1)=":"
alarm$(budi|)="0"+alarm$(budi|)
ENDIF
EXIT IF MID$(alarm$(budi|),3,1)<>":"
alarm$(budi|)=alarm$(budi|)+":00"
PRINT
PRINT " (";budi|;".) ENTER ALARM MESSAGE :"
PRINT " ";
INPUT amessage$(budi|)
NEXT budi|
IF MID$(alarm$(budi|),3,1)<>":" AND budi|<=budikov|
PRINT
PRINT
PRINT " WRONG TIME - TRY ONCE AGAIN !!!"
DELAY 7
GOTO budiznova
ENDIF
CLS
weekday
currentdateonscreen
currentitemonscreen
CASE 32
REM "TOM --> TRANS"
tomtrans
CLS
weekday
currentdateonscreen
currentitemonscreen
CASE 33
REM "TRANS --> TOM"
transtom
CLS
weekday
currentdateonscreen
currentitemonscreen
CASE 34
REM "TOM --> KOI"
tomkoi
CLS
weekday
currentdateonscreen
currentitemonscreen
CASE 35
REM "KOI --> TOM"
koitom
CLS
weekday
currentdateonscreen
currentitemonscreen
CASE 36
REM "TOM --> TWIG"
tomtwig
CLS
weekday
currentdateonscreen
currentitemonscreen
CASE 37
REM "TWIG --> TOM"
twigtom
CLS
weekday
currentdateonscreen
currentitemonscreen
CASE 38
REM "PBX --> KOI"
pbxkoi
CLS
weekday
currentdateonscreen
currentitemonscreen
CASE 39
REM "KOI --> PBX"
koipbx
CLS
weekday
currentdateonscreen
currentitemonscreen
CASE 40
REM "PBX --> TRANS"
pbxtrans
CLS
weekday
currentdateonscreen
currentitemonscreen
CASE 41
REM "TRANS --> PBX"
transpbx
CLS
weekday
currentdateonscreen
currentitemonscreen
ENDSELECT
RETURN
REM ---------------------------------------------------------------
PROCEDURE actualdate
REM EXTRAHOVANIE SKUTOCNEHO AKTUALNEHO DATUMU DO PREMENNYCH day&, month&, year%
day&=VAL(LEFT$(DATE$,2))
month&=VAL(MID$(DATE$,4,2))
year%=VAL(RIGHT$(DATE$,4))
RETURN
REM ---------------------------------------------------------------
PROCEDURE currentdateonscreen
IF m&(2)=29
PRINT AT(6,3);day&;".";month&;".";year%;" "+d$(b&)+" "+TIME$+" ";tyzden%;".WEEK ";denvroku%;".DAY LEAP YEAR";SPC(5)
ELSE IF m&(2)=28
PRINT AT(6,3);day&;".";month&;".";year%;" "+d$(b&)+" "+TIME$+" ";tyzden%;".WEEK ";denvroku%;".DAY NOT LEAP YEAR";SPC(5)
ENDIF
RETURN
REM ---------------------------------------------------------------
PROCEDURE currentitemonscreen
TITLEW #1,"*********************************** GALAXIS ***********************************"
REM NA OBRAZOVKE SA UKAZU ALL ITEMs PRE CURRENT DATE
REM TERAZ: AK ESTE ADDRESSES NIE JE V PAMATI, ALEBO AK SA ZMENILA JEHO DLZKA, TAK SA NAHRAJA ZNOVA
GOTO skok
OPEN "i",#1,"DH3:Words/NOTES/NOTES.PBX"
IF lof%=0 OR LOF(#1)<>lof%
CLR bloch&
lof%=LOF(#1)
REM Teraz sa citac nastavi na prvy riadok adries:
FOR riadky%=1 TO svet%
LINE INPUT #1,slava$
EXIT IF LEFT$(slava$,3)=" *"
NEXT riadky%
FOR riadky%=1 TO svet%
LINE INPUT #1,slava$(riadky%)
EXIT IF EOF(#1)
IF slava$(riadky%)=""
INC bloch&
ENDIF
NEXT riadky%
ENDIF
CLOSE #1
skok:
aatum$=STR$(day&)+"."+STR$(month&)
atum$=STR$(day&)+"."+STR$(month&)+"."+STR$(year%)
lin|=8
CLR super&
FOR nx%=1 TO riadky%
IF slava$(nx%)=aatum$ OR slava$(nx%)=atum$
DO
INC nx%
PRINT AT(6,lin|);slava$(nx%)
EXIT IF slava$(nx%)=""
INC lin|
EXIT IF nx%=riadky%
LOOP
ENDIF
IF slava$(nx%)=""
INC super&
ENDIF
NEXT nx%
PRINT AT(6,5);"Number of items: ";super&;" out of ";lof%;" bytes"
RETURN
REM ---------------------------------------------------------------
PROCEDURE weekday
REM POKIAL IDE O TYZDEN - NASE KALENDARE OCISLUJU CISLOM 1 TYZDEN, V KTOROM
REM SA OBJAVI 1.JANUAR a MAJU TEDA 53 TYZDNOV; ZAHRANICNE ZACNU TYZDEN c. 1
REM AZ PRVYM JANUAROVYM PONDELKOM. JA POUZIJEM ZAHRANICNY MODEL (52 TYZDNOV,
REM ALE AJ 53 V PRIPADE, KED JE PRESTUPNY ROK A POSLEDNY 366. DEN JE PONDELOK)
REM NASLEDUJUCE VYPOCITA DEN V TYZDNI A PORADIE TYZDNA V ROKU
RESTORE kalendar
FOR n&=1 TO 7
READ d$(n&)
NEXT n&
FOR n&=1 TO 12
READ m&(n&)
NEXT n&
IF FRAC(year%/4)=0
m&(2)=29
ELSE
m&(2)=28
ENDIF
REM tesla|(rok 1996-2023) je pole, kde su pre dane roky uvedene januarove datumy,
REM ktore zodpovedaju prvemu tyzdnu roka podla western modelu (prvy januarovy pondelok)
FOR n&=1996 TO 2023
READ tesla|(n&)
NEXT n&
REM MAM DOVOD NEDAT VSETKY PODMIENKY DO JEDNEHO IF-u !!!
wrongdate!=FALSE
IF month&<1 OR month&>12
wrongdate!=TRUE
GOTO tarzan
ELSE
IF year%<1 OR year%>svet% OR day&<1 OR day&>m&(month&)
wrongdate!=TRUE
GOTO tarzan
ENDIF
ENDIF
REM toto je pocet dni od zaciatku letopoctu po koniec predosleho roka
bb%=ADD(MUL(365,(PRED(year%))),TRUNC((PRED(year%))/4))
denvroku%=bb%
REM pricita sa pocet dni do konca minuleho mesiaca
FOR n&=1 TO PRED(month&)
ADD bb%,m&(n&)
NEXT n&
REM PLUS DEN V TOMTO MESIACI; V bb% JE TEDA CELK. POCET DNI OD ROKU 0 DODNES:
ADD bb%,day&
REM denvroku% je poradove cislo daneho dna v danom roku
denvroku%=SUB(bb%,denvroku%)
REM b& = ETALONOVY DEN V TYZDNI (1 = PONDELOK, 14.6.1993)
b&=betalon&
REM dilu% = ETALONOVE PORADOVE CISLO DNA OD ROKU 0 DO DNA ETALONOVEHO DATUMU
dilu%=bbetalon%
sss%=70000000
tyzden%=1
REM AK bb%=dilu% SKOCI ZA IF-y A BUDU PLATIT ETALONOVE UDAJE b& (a d$(b&) a tyzden%)
IF bb%>dilu%
REM TATO SLUCKA JE ZAZRAKOM - ZMENSI ROZDIEL MEDZI bb% A dilu% NA MENSI,
REM ALEBO ROVNY 7 A V DALSEJ SLUCKE SA POTOM UZ DOPOCITA PRESNY DEN...
REM A TYZDEN. POZOR !!! V sss% MUSI BYT CISLO DELITELNE 7 a 10, ABY PRI
REM PRIBLIZOVANI BOL STALE PONDELOK
FOR bang|=1 TO 7
sss%=sss%/10
FOR roky%=dilu% TO svet% STEP sss%
IF roky%>bb%
dilu%=SUB(roky%,sss%)
ENDIF
EXIT IF roky%>bb%
NEXT roky%
NEXT bang|
FOR roky%=SUCC(dilu%) TO bb%
INC b&
IF b&=8
b&=1
ENDIF
NEXT roky%
ELSE IF bb%<dilu%
REM TATO SLUCKA JE ZAZRAKOM - ZMENSI ROZDIEL MEDZI bb% A dilu% NA MENSI,
REM ALEBO ROVNY 7 A V DALSEJ SLUCKE SA POTOM UZ DOPOCITA PRESNY DEN...
REM A TYZDEN. POZOR !!! V sss% MUSI BYT CISLO DELITELNE 7 a 10, ABY PRI
REM PRIBLIZOVANI BOL STALE PONDELOK
FOR bang|=1 TO 7
sss%=sss%/10
FOR roky%=dilu% TO -svet% STEP -sss%
IF roky%<bb%
dilu%=ADD(roky%,sss%)
ENDIF
EXIT IF roky%<bb%
NEXT roky%
NEXT bang|
FOR roky%=PRED(dilu%) DOWNTO bb%
DEC b&
IF b&=0
b&=7
ENDIF
NEXT roky%
ENDIF
REM -----------------------------
REM VYPOCET TYZDNA
podoba%=year%
DO
EXIT IF podoba%>=1996 AND podoba%<=2023
IF podoba%<1996
ADD podoba%,28
ELSE IF podoba%>2023
SUB podoba%,28
ENDIF
LOOP
REM teraz sa vypocita pocet dni od zaciatku letopoctu po prvy januarovy
REM pondelok tzv. podobneho roka; potrebne pre vypocet tyzdna:
special%=ADD(MUL(365,PRED(podoba%)),ADD(TRUNC((PRED(podoba%))/4),tesla|(podoba%)))
REM toto je pocet dni od zaciatku letopoctu po dany den, ale V tzv. PODOBNOM ROKU !
bbspecial%=ADD(MUL(365,PRED(podoba%)),TRUNC((PRED(podoba%))/4))
FOR n&=1 TO PRED(month&)
ADD bbspecial%,m&(n&)
NEXT n&
ADD bbspecial%,day&
REM NASLEDUJUCE SA VYKONA AK JE TO ESTE 52 (53) TYZDEN (WESTERN MODEL)
IF day&<tesla|(podoba%) AND month&=1
REM AK BOL PREDOSLY ROK PODOBNY ROKU 2012 (PRESTUPNY A ZACINA NEDELOU), TAK
REM BOL POSLEDNY DEN (c. 366) PONDELOK, CO JE JEDINY PRIPAD VO WESTERN
REM MODELE (RAZ ZA 28 ROKOV) KED MA ROK 53 TYZDNOV
IF PRED(podoba%)=2012
tyzden%=53
ELSE
tyzden%=52
ENDIF
GOTO tarzan
ENDIF
REM NASLEDUJUCA SLUCKA UROBI ROZDIEL O NULA AZ 7 DNI NAD bb%
DO
EXIT IF SUB(special%,bbspecial%)>=0 AND SUB(special%,bbspecial%)<7
ADD special%,7
INC tyzden%
LOOP
REM NASLEDUJUCI IF RIESI AK JE DEN (CISLO b&) V PREDOSLOM TYZDNI AKO tyzden%
IF ADD(SUB(special%,bbspecial%),b&)>7
DEC tyzden%
ENDIF
REM --------------------------
tarzan:
REM TU SA RIESI wrongdate!, ALE OKREM 29.FEB, TEN SA RIESI V sortsave
IF wrongdate!=TRUE AND (day&<>29 AND month&<>2)
PRINT AT(6,10);"DATE ";day&;".";month&;".";year%;" IS WRONG, CHANGE IT IN ADDRESSES.PBX FILE"
PRINT AT(6,15);"*** PRESS ANY KEY TO EXIT GALAXIS ***"
WHILE INKEY$=""
WEND
CLOSE
CLOSES 1
EDIT
ENDIF
REM vysledok je v tyzden% a d$(b&)
RETURN
REM ---------------------------------------------------------------------------
PROCEDURE sortsave
CLS
currentdateonscreen
dday&=day&
mmonth&=month&
yyear%=year%
REM VYPOCET DATUMCISLA AKTUALNEHO DATUMU
REM (DATUMCISLO = poradove cislo dna od roku 0) A POTOM SA VYTRIEDI A VYPISE
IF FRAC(yyear%/4)=0
m&(2)=29
ELSE
m&(2)=28
ENDIF
CLR dni&
FOR n&=1 TO PRED(mmonth&)
ADD dni&,m&(n&)
NEXT n&
ADD dni&,dday&
dnesnedatumcislo%=ADD(dni&,ADD(MUL(365,PRED(yyear%)),TRUNC((PRED(yyear%))/4)))
REM VYPOCET CISLA POSLEDNEHO TESTOVANEHO DATUMU
konecnedatumcislo%=ADD(dnesnedatumcislo%,PRED(numb%))
REM VYPOCET CISLA 31.12 AKTUALNEHO ROKA
CLR dni&
FOR n&=1 TO 12
ADD dni&,m&(n&)
NEXT n&
datumcislo3112%=ADD(dni&,ADD(MUL(365,PRED(yyear%)),TRUNC((PRED(yyear%))/4)))
PRINT AT(6,5);"Done ";AT(15,5);" of total ";bloch&;" items"
poradie%=-1
itemfirstpredosly%=1
REM pripocet% BUDE ZA DO-LOOP OBSAHOVAT POCET PRESKOCENYCH 29.2 S NEPRESTUPNYM
REM ROKOM - TREBA HO PRIPOCITAT K poradie%, LEBO TO SA DEKREMENTOVALO A TIEZ
REM PRESKOCENYCH KED SA NEVYPISOVALI ANNUAL ITEMs
CLR pripocet%
FOR nx%=1 TO riadky%
IF slava$(nx%)=""
INC poradie%
PRINT AT(11,5);SUCC(poradie%)
REM ------------MAMDA$-----------
REM TERAZ SA VYEXTRAHUJE DATUM POLOZKY A VYPOCITA DATUMCISLO
INC nx%
REM itemfirst%(poradie%) ukazuje na zaciatok itemu, na jeho datum
itemfirst%(poradie%)=nx%
pozn!=FALSE
erste|=INSTR(slava$(nx%),".")
day&=VAL(LEFT$(slava$(nx%),PRED(erste|)))
zweite|=RINSTR(slava$(nx%),".")
IF erste|=zweite|
IF annual!=FALSE
DEC poradie%
INC pripocet%
GOTO vezmidalsie
ENDIF
REM ZNAMENA ZE DRUHA BODKA NIE JE A ITEM JE TEDA ANNUAL
pozn!=TRUE
month&=VAL(RIGHT$(slava$(nx%),SUB(LEN(slava$(nx%)),erste|)))
REM AKO ROK PRE ANNUAL ITEMY DAM AKTUALNY ROK, AK UZ ALE TEN DATUM V TOMTO ROKU BOL, IDE DO BUDUCEHO ROKA
year%=yyear%
IF FRAC(year%/4)=0
m&(2)=29
ELSE
m&(2)=28
ENDIF
CLR dni&
FOR n&=1 TO PRED(month&)
ADD dni&,m&(n&)
NEXT n&
ADD dni&,day&
datumcislo%(poradie%)=ADD(dni&,ADD(MUL(365,PRED(year%)),TRUNC((PRED(year%))/4)))
IF dnesnedatumcislo%>datumcislo%(poradie%)
INC year%
IF FRAC(year%/4)=0
m&(2)=29
ELSE
m&(2)=28
ENDIF
CLR dni&
FOR n&=1 TO PRED(month&)
ADD dni&,m&(n&)
NEXT n&
ADD dni&,day&
datumcislo%(poradie%)=ADD(dni&,ADD(MUL(365,PRED(year%)),+TRUNC((PRED(year%))/4)))
ENDIF
ELSE
REM ZNAMENA ZE SU DVE BODKY A ITEM JE PRE JEDEN PRESNY DATUM
month&=VAL(MID$(slava$(nx%),SUCC(erste|),SUB(zweite|,erste|)))
year%=VAL(RIGHT$(slava$(nx%),SUB(LEN(slava$(nx%)),zweite|)))
IF FRAC(year%/4)=0
m&(2)=29
ELSE
m&(2)=28
ENDIF
CLR dni&
FOR n&=1 TO PRED(month&)
ADD dni&,m&(n&)
NEXT n&
ADD dni&,day&
datumcislo%(poradie%)=ADD(dni&,ADD(MUL(365,PRED(year%)),TRUNC((PRED(year%))/4)))
ENDIF
REM -------------------- TEST NA WRONGDATE -----------------------------
REM VZNIKOL PROBLEM - PRI UKAZOVANI ANNUAL 29-2 SA OBJAVOVALO WRONGDATE
REM ALE NASLEDUJUCE TRI AND-y V IF-e TO ODSTRANIA
REM KED JE TEN DEN A NEPRESTUPNY ROK (WRONGDATE), TEN DEN SA JEDNODUCHO NEVYPISE,
REM ALE NEZASTAVI SA BEH AKOBY TO BOLO CHYBNE ZADANIE, ALE LEN AK TO JE ANNUAL
REM ITEM, TEDA pozn!=TRUE (TEDA -1)
IF day&=29 AND month&=2 AND pozn!=TRUE AND FRAC(year%/4)<>0
REM DEC poradie% je tu, aby sa posl. udaje (zac itemu, ...) zmazali
REM A IDEME ODZNOVA (TENTO IF MUSI BYT TESNE PRED LOOP !!!)
DEC poradie%
INC pripocet%
GOTO vezmidalsie
ELSE IF day&=29 AND month&=2 AND pozn!=FALSE AND FRAC(year%/4)<>0
PRINT AT(6,10);"DATE ";day&;".";month&;".";year%;" IS WRONG, CHANGE IT IN ADDRESSES.PBX FILE"
PRINT AT(6,15);"*** PRESS ANY KEY TO EXIT GALAXIS ***"
WHILE INKEY$=""
WEND
CLOSE
CLOSES 1
EDIT
ENDIF
ENDIF
vezmidalsie:
NEXT nx%
REM TU JE PRINT AKO OPRAVA ZA PRESKOCENE ITEMY 29.2. S NEPRESTUPNYM ROKOM
PRINT AT(11,5);ADD(SUCC(poradie%),pripocet%);" of total ";bloch&;" items";SPC(2)
REM ----------- SLUCKA VYPISU NA OBRAZOVKU A DO SORTEDPLATYS.PBX ---------
CLS
OPEN "o",#2,"HDW:Super-Data/Words/NOTES/SORTEDPLATYS.PBX"
PRINT AT(1,2);
CLR predosledatumcislo%
IF numb%<366
CLR pocetrokov%
ELSE
pocetrokov%=PRED(TRUNC(numb%/366))
ENDIF
FOR gitara%=0 TO pocetrokov%
FOR ja%=dnesnedatumcislo% TO konecnedatumcislo%
FOR marus%=0 TO poradie%
IF ja%=datumcislo%(marus%)
exor%=itemfirst%(marus%)
REM ------------SKRATENA MAMDA$-----------
REM TERAZ SA LEN VYEXTRAHUJE DATUM POLOZKY - KVOLI weekday
erste|=INSTR(slava$(exor%),".")
day&=VAL(LEFT$(slava$(exor%),PRED(erste|)))
zweite|=RINSTR(slava$(exor%),".")
IF erste|=zweite|
month&=VAL(RIGHT$(slava$(exor%),SUB(LEN(slava$(exor%)),erste|)))
IF SUB(datumcislo%(marus%),dnesnedatumcislo%)<=SUB(datumcislo3112%,dnesnedatumcislo%)
year%=ADD(yyear%,gitara%)
ELSE
year%=ADD(yyear%,SUCC(gitara%))
ENDIF
ELSE IF erste|<>zweite|
IF gitara%>0
GOTO pangamin
ENDIF
month&=VAL(MID$(slava$(exor%),SUCC(erste|),SUB(zweite|,erste|)))
year%=VAL(RIGHT$(slava$(exor%),SUB(LEN(slava$(exor%)),zweite|)))
ENDIF
REM --------------------------------------
weekday
IF predosledatumcislo%<>datumcislo%(marus%)
IF predosledatumcislo%<>0
PRINT
PRINT #2
ENDIF
spac|=3
IF tyzden%>9
spac|=4
ENDIF
PRINT #2;tyzden%;". ";d$(b&);" ";day&;".";month&;".";year%
PRINT tyzden%;". ";d$(b&);" ";day&;".";month&;".";year%
ENDIF
DO
INC exor%
EXIT IF slava$(exor%)=""
PRINT #2,SPC(spac|);slava$(exor%)
PRINT SPC(spac|);slava$(exor%)
EXIT IF exor%=SUCC(riadky%)
LOOP
predosledatumcislo%=datumcislo%(marus%)
ENDIF
pangamin:
NEXT marus%
NEXT ja%
NEXT gitara%
REM --------------------------------------------------------------------
PRINT
PRINT
PRINT SPC(9);"*** PRESS ANY KEY TO RETURN TO THE MAIN MENU ***"
CLOSE #2
FRONTS 1
WHILE INKEY$=""
WEND
day&=dday&
month&=mmonth&
year%=yyear%
RETURN
REM ---------------------------------------------------------------------------
PROCEDURE solarsystem
CLS
TITLEW #1," SOLAR SYSTEM"
REM TU ZACINA PROGRAM KRESLENIA PLANET
REM 25.12.1993
REM Vychodna zemepisna dlzka Poprad (IBA MOJ ODHAD) 23 stupnov (teda
REM v hodinach je to (23/360)*24, v sekundach (23/360)*24*3600
REM Severna zemepisna sirka Poprad (IBA MOJ ODHAD) 49 stupnov
REM Miestny hviezdny cas TH:
REM - S0 = zdanlivy hviezdny cas na Greenwich poludniku (v tabulkach slnka)
REM - T = pasmovy cas
REM - LAMBDAP = z. dlzka daneho miesta, v hodinach, kladne sem od Greenwicha
REM - LAMBDA
DEFMOUSE 3
stredx=319
stredy=127
REM PCIRCLE 20,20,11
REM OPEN "i",#1,"vd0:tina.bob.pal"
REM FOR v&=0 TO PRED(LOF(#1)/2)
REM BGET #1,V:c&,2
REM SETCOLOR v&,c&
REM NEXT v&
REM CLOSE #1
OPEN "i",#1,"vd0:tina.bob"
s$=INPUT$(LOF(#1),#1)
MID$(s$,22,1)=CHR$(255)
OBJECT.SHAPE 2,s$
CLOSE #1
CLR u
CLR v
DEFFILL 1,3
CIRCLE stredx,stredy,250
FILL stredx,stredy
OBJECT.CLIP 0,0,640,256
OBJECT.VX 2,100
OBJECT.VY 2,100
FOR x=0 TO 360 STEP 0.07
OBJECT.OFF
a=SIN(x)*100+stredx
b=(COS(x)+0.2)*100++stredy
OBJECT.X 2,a
OBJECT.Y 2,b
OBJECT.ON
NEXT x
STOP
DO
x$=INKEY$
IF x$="4"
OBJECT.OFF
SUB u,5
OBJECT.X 2,u
OBJECT.ON
ELSE IF x$="6"
OBJECT.OFF
ADD u,5
OBJECT.X 2,u
OBJECT.ON
ELSE IF x$="8"
OBJECT.OFF
SUB v,5
OBJECT.Y 2,v
OBJECT.ON
ELSE IF x$="2"
OBJECT.OFF
ADD v,5
OBJECT.Y 2,v
OBJECT.ON
ENDIF
LOOP
STOP
REM ------------------- TU JE DEMO2, VYMAZAT HNED AKO NEPOTREBNE ---
' Load the palette and set the colors properly
OPEN "i",#1,"df0:bobs/demo.pal"
FOR v&=0 TO PRED(LOF(#1)/2)
BGET #1,V:c&,2
SETCOLOR v&,c&
NEXT v&
CLOSE #1
' load a bob: (green magician)
OPEN "i",#1,"df0:bobs/magic.bob"
s$=INPUT$(LOF(#1),#1)
MID$(s$,22,1)=CHR$(8)
OBJECT.SHAPE 2,s$
CLOSE #1
MID$(s$,22,1)=CHR$(16)
OBJECT.SHAPE 3,s$ ! blue magician
OBJECT.PLANES 2
' use OBJECT.PLANES to change the color (plane 1 filled with 0`s)
OBJECT.PLANES 3,29,0
OBJECT.X 3,300
OBJECT.Y 3,100
OBJECT.VX 3,-100
OBJECT.PRIORITY 3,10 ! blue mag. in front
OBJECT.PRIORITY 2,20 ! green mag.
' set clipping
OBJECT.CLIP 0,0,600,240
OBJECT.ON
OBJECT.START
TITLEW #1,"Waiting for space..."
WHILE INKEY$<>" "
OBJECT.X 2,MOUSEX
OBJECT.Y 2,MOUSEY
WEND
OBJECT.STOP
OBJECT.CLOSE
CLOSES 1
RETURN
PROCEDURE chester
LOCAL toggle|,ink$,bhaho$,ahaho$,pass$,passlen|,x|,x%,xx%,ahalen%,chester&
CLS
REM THE CHESTER ENCRYPTOR
REM 3. SEPTEMBER 1994 (Tomas J. Fulopp, +42 - (0)92 - 32814)
TITLEW #1,"CHESTER by Tomas J. Fulopp, September 3rd, 1994"
PRINT AT(3,3);"HIT SPACE TO SELECT, ENTER TO CONTINUE :"
CLR toggle|
PRINT AT(3,5);"- CIPHER A FILE -"
DO
ink$=INKEY$
EXIT IF ink$=CHR$(13)
IF ink$=CHR$(32)
IF toggle|=0
toggle|=1
PRINT AT(3,5);"- CIPHER OUT A FILE -"
ELSE
CLR toggle|
PRINT AT(3,5);"- CIPHER A FILE -";SPC(5)
ENDIF
ENDIF
LOOP
IF toggle|=0
FILESELECT "Select NORMAL Ascii File","OK","HDW:Super-Data/Words/",ahaho$
IF RIGHT$(ahaho$,4)=".CHE"
CLS
PRINT AT(10,10);"IMPOSSIBLE TO CIPHER CIPHERED !!!"
DELAY 7
GOTO salon
ENDIF
ELSE
FILESELECT "Select CIPHERED Ascii File","OK","HDW:Super-Data/Words/",ahaho$
IF RIGHT$(ahaho$,4)<>".CHE"
CLS
PRINT AT(10,10);"IMPOSSIBLE TO UNCIPHER UNCIPHERED !!!"
DELAY 7
GOTO salon
ENDIF
ENDIF
OPEN "i",#77,ahaho$
IF LOF(#77)=0
CLS
PRINT AT(10,10);"THIS FILE HAS ZERO LENGTH !!!"
DELAY 7
CLOSE #77
GOTO salon
ELSE
CLOSE #77
ENDIF
PRINT AT(3,8);"OLD FILE: ";ahaho$
IF toggle|=1
PRINT AT(3,13);"PASSWORD: ";
FORM INPUT 255,pass$
ELSE
pass$="Danica"
ENDIF
byk&=LEN(pass$)
PRINT AT(13,13);SPC(byk&)
passlen|=LEN(pass$)
FOR x|=1 TO passlen|
pass|(x|)=ASC(MID$(pass$,x|,1))
NEXT x|
OPEN "i",#77,ahaho$
IF toggle|=0
bhaho$=RIGHT$(ahaho$,LEN(ahaho$))+".CHE"
ELSE
bhaho$=LEFT$(ahaho$,SUB(LEN(ahaho$),4))
ENDIF
PRINT AT(3,10);"NEW FILE: ";bhaho$
OPEN "o",#78,bhaho$
ahalen%=LOF(#77)
PRINT AT(3,20);"PROCESSING ";ahalen%;" BYTES... ";
IF toggle|=0
CLR x|
FOR x%=1 TO ahalen%
INC x|
IF x|>passlen|
x|=1
ENDIF
chester&=ADD(INP(#77),pass|(x|))
IF chester&>255
SUB chester&,255
ENDIF
OUT #78,chester&
NEXT x%
ELSE
CLR x|
FOR x%=1 TO ahalen%
INC x|
IF x|>passlen|
x|=1
ENDIF
chester&=SUB(INP(#77),pass|(x|))
IF chester&<1
ADD chester&,255
ENDIF
OUT #78,chester&
NEXT x%
ENDIF
CLOSE #78
CLOSE #77
OPEN "i",#77,bhaho$
xx%=LOF(#77)
OPEN "o",#78,bhaho$+".bak"
FOR x%=1 TO xx%
x|=INP(#77)
OUT #78,x|
NEXT x%
CLOSE #78
CLOSE #77
OPEN "o",#77,ahaho$
CLOSE #77
OPEN "o",#77,ahaho$+".bak"
CLOSE #77
PRINT "DONE ";
DELAY 6
PRINT "!!!"
DELAY 1
salon:
RETURN
REM ---------------------------------------------------------------------------
REM ------------------ NASLEDUJU PROCEDURY TRANSFORMATOROV --------------------
PROCEDURE tomtrans
CLS
RESTORE t11
LOCAL ahaho$,suffix$,zac,x&,t|,lof
LOCAL slava|,trans%,kon,tim,h,m,s,c!
TITLEW #1," February 9, 1994 TOM --> TRANS "
FILESELECT "Select TOM File","OK","DH3:",ahaho$
suffix$="-TRANS"
huh|=82
zavertrans
RETURN
PROCEDURE transtom
CLS
RESTORE t11
LOCAL ahaho$,suffix$,zac,x&,t|,lof
LOCAL slava|,trans%,kon,tim,h,m,s,c!
TITLEW #1," February 9, 1994 TRANS --> TOM "
FILESELECT "Select TRANS File","OK","DH3:",ahaho$
suffix$="-TOM"
huh|=82
zavertrans2
REM -------------------- BOD ZMENY
t11:
DATA $e3,$c5,$e9,$d3,$e1,$c3,$e8,$d2,$ee,$da,$dd,$d9,$e0,$c1,$e5,$c9,$e4,$d6
DATA $eb,$d5,$a4,$c6,$ec,$ca,$b8,$d1,$aa,$cb,$ac,$cc,$d4,$c0,$c3,$e5,$c9,$f3
DATA $c1,$e3,$c8,$f2,$ce,$fa,$cd,$f9,$c0,$e1,$c5,$e9,$c4,$f6,$cb,$f5,$a5,$e6
DATA $cc,$ea,$b7,$f1,$ab,$eb,$ad,$ec,$d7,$e0,$c2,$e4,$ca,$f4,$c6,$ee,$c7,$ef
DATA $e2,$c4,$ea,$d4,$e6,$ce,$e7,$cf,160,32
REM ------------------------------
REM KONIEC
RETURN
PROCEDURE tomkoi
CLS
RESTORE t22
LOCAL ahaho$,suffix$,zac,x&,t|,lof
LOCAL slava|,trans%,kon,tim,h,m,s,c!
TITLEW #1," February 9, 1994 TOM --> KOI "
FILESELECT "Select TOM File","OK","DH3:",ahaho$
suffix$="-KOI"
huh|=86
zavertrans
RETURN
PROCEDURE koitom
CLS
RESTORE t22
LOCAL ahaho$,suffix$,zac,x&,t|,lof
LOCAL slava|,trans%,kon,tim,h,m,s,c!
TITLEW #1," February 9, 1994 KOI --> TOM "
FILESELECT "Select KOI File","OK","DH3:",ahaho$
suffix$="-TOM"
huh|=86
zavertrans2
REM -------------------- BOD ZMENY
t22:
DATA $a4,$c6,$a5,$e6,$aa,$cb,$ab,$eb,$ac,$cc,$ad,$ec,$af,$b1,$b1,$b9,$b4,$ba
DATA $b7,$f1,$b8,$d1,$c0,$e1,$c1,$e3,$c2,$e4,$c3,$e5,$c4,$f7,$c5,$e9,$c6,$ee
DATA $c7,$ef,$c8,$f2,$c9,$f3,$ca,$f4,$cb,$f5,$cc,$ea,$cd,$f9,$ce,$fa,$d4,$d0
DATA $d7,$f0,$dd,$d9,$e0,$c1,$e1,$c3,$e2,$c4,$e3,$c5,$e4,$d7,$e5,$c9,$e6,$ce
DATA $e7,$cf,$e8,$d2,$e9,$d3,$ea,$d4,$eb,$d5,$ec,$ca,$ee,$da
REM ------------------------------
REM KONIEC
RETURN
PROCEDURE tomtwig
CLS
RESTORE t33
LOCAL ahaho$,suffix$,zac,x&,t|,lof
LOCAL slava|,trans%,kon,tim,h,m,s,c!
TITLEW #1," February 9, 1994 TOM --> TWIG "
FILESELECT "Select TOM File","OK","DH3:",ahaho$
suffix$="-TWIG"
huh|=62
zavertrans
RETURN
PROCEDURE twigtom
CLS
RESTORE t33
LOCAL ahaho$,suffix$,zac,x&,t|,lof
LOCAL slava|,trans%,kon,tim,h,m,s,c!
TITLEW #1," February 9, 1994 TWIG --> TOM "
FILESELECT "Select TWIG File","OK","DH3:",ahaho$
suffix$="-TOM"
huh|=62
zavertrans2
REM -------------------- BOD ZMENY
t33:
DATA $60,$e8,$e2,$40,$e3,$5b,$e9,$7b,$e1,$3e,$e8,$60,$ee,$2a,$dd,$28,$e0,$3c
DATA $e5,$5d,$e4,$26,$7e,$eb,$2a,$ee,$5f,$e7,$eb,$7e,$e7,$5f,$5b,$e3,$5d,$e5
DATA $26,$e4,$28,$dd,$40,$e2,$ea,$7d,$ec,$7f,$ac,$23,$e6,$5e,$23,$ac,$3c,$e0
DATA $3e,$e1,$5e,$e6,$7b,$e9,$7d,$ea
REM ------------------------------
REM KONIEC
RETURN
PROCEDURE pbxkoi
CLS
RESTORE t44
LOCAL ahaho$,suffix$,zac,t|,lof
LOCAL slava|,trans%,kon,tim,h,m,s
TITLEW #1," January 23, 1996 PBX --> KOI "
FILESELECT "Select PBX File","OK","DH3:",ahaho$
suffix$="-KOI"
huh|=82
zavertrans
RETURN
PROCEDURE koipbx
CLS
RESTORE t44
LOCAL ahaho$,suffix$,zac,t|,lof
LOCAL slava|,trans%,kon,tim,h,m,s
TITLEW #1," January 23, 1996 KOI --> PBX "
FILESELECT "Select KOI File","OK","DH3:",ahaho$
suffix$="-PBX"
huh|=82
zavertrans2
REM -------------------- BOD ZMENY
t44:
DATA $c1,$e1,$c4,$f1,$c7,$e3,$c8,$e4,$c9,$f7,$ca,$e5,$cd,$e9,$ce,$ec,$cf,$eb
DATA $d0,$f2,$d1,$ee,$d3,$ef,$d4,$f0,$d5,$e6,$d6,$ed,$d7,$f3,$d9,$f4,$da,$f5
DATA $db,$ea,$dd,$f9,$de,$fa,$e1,$c1,$e4,$d1,$e7,$c3,$e8,$c4,$e9,$d7,$ea,$c5
DATA $ed,$c9,$ee,$cc,$ef,$cb,$f0,$d2,$f1,$ce,$f3,$cf,$f4,$d0,$f5,$c6,$f7,$d3
DATA $f9,$d4,$fa,$d5,$fb,$ca,$fd,$d9,$fe,$da
REM ------------------------------
REM KONIEC
RETURN
PROCEDURE zavertrans
zac=TIMER
FOR t|=1 TO huh|
READ john|(t|)
NEXT t|
PRINT AT(3,10);"Transformed characters: "
PRINT AT(3,23);ahaho$
PRINT AT(3,27);ahaho$+suffix$
OPEN "i",#1,ahaho$
OPEN "o",#2,ahaho$+suffix$
lof=LOF(#1)
PRINT AT(3,6);"Done ";AT(11,6);"% out of total ";lof;" bytes"
DO
slava|=INP(#1)
REM ---------------------- BOD ZMENY
FOR t|=1 TO huh| STEP 2
IF slava|=john|(t|)
slava|=john|(SUCC(t|))
t|=huh|
INC trans%
perc|=INT((100*LOC(#1))/lof)
IF perc|<>percst|
PRINT AT(27,10);trans%;AT(8,6);perc|
percst|=perc|
ENDIF
ENDIF
NEXT t|
OUT #2,slava|
EXIT IF LOC(#1)>=lof
LOOP
PRINT AT(27,10);trans%;AT(8,6);INT((100*LOC(#1))/lof)
CLOSE #2
CLOSE #1
kon=TIMER
FRONTS 1
tim=(kon-zac)/200
h=TRUNC(tim/3600)
m=TRUNC(FRAC(tim/3600)*60)
s=INT(FRAC(FRAC(tim/3600)*60)*60)
PRINT AT(3,15);"Time: ";h;"h ";m;"m ";s;"s"
PRINT AT(3,18);"SAVING ..."
DELAY 5
RETURN
PROCEDURE zavertrans2
zac=TIMER
FOR t|=1 TO huh|
READ john|(t|)
NEXT t|
PRINT AT(3,10);"Transformed characters: "
PRINT AT(3,23);ahaho$
PRINT AT(3,27);ahaho$+suffix$
OPEN "i",#1,ahaho$
OPEN "o",#2,ahaho$+suffix$
lof=LOF(#1)
PRINT AT(3,6);"Done ";AT(11,6);"% out of total ";lof;" bytes"
DO
slava|=INP(#1)
REM ---------------------- BOD ZMENY
FOR t|=2 TO huh| STEP 2
IF slava|=john|(t|)
slava|=john|(PRED(t|))
t|=huh|
INC trans%
perc|=INT((100*LOC(#1))/lof)
IF perc|<>percst|
PRINT AT(27,10);trans%;AT(8,6);perc|
percst|=perc|
ENDIF
ENDIF
NEXT t|
OUT #2,slava|
EXIT IF LOC(#1)>=lof
LOOP
PRINT AT(27,10);trans%;AT(8,6);INT((100*LOC(#1))/lof)
CLOSE #2
CLOSE #1
kon=TIMER
FRONTS 1
tim=(kon-zac)/200
h=TRUNC(tim/3600)
m=TRUNC(FRAC(tim/3600)*60)
s=INT(FRAC(FRAC(tim/3600)*60)*60)
PRINT AT(3,15);"Time: ";h;"h ";m;"m ";s;"s"
PRINT AT(3,18);"SAVING ..."
DELAY 5
RETURN
REM ---------------------------------------------------------------------------
PROCEDURE pbxtrans
REM pbxkoi
CLS
RESTORE t44
LOCAL ahaho$,suffix$,zac,t|,lof
LOCAL slava|,trans%,kon,tim,h,m,s,c|
TITLEW #1," January 23, 1996 PBX --> TRANS "
FILESELECT "Select PBX File","OK","DH3:",ahaho$
c|=1
huh|=82
zac=TIMER
zavertransplus
CLS
REM koitom
RESTORE t22
c|=2
huh|=86
zavertransplus2
CLS
REM tomtrans
RESTORE t11
suffix$="-TRANS"
c|=3
huh|=82
zavertransplus
kon=TIMER
FRONTS 1
tim=(kon-zac)/200
h=TRUNC(tim/3600)
m=TRUNC(FRAC(tim/3600)*60)
s=INT(FRAC(FRAC(tim/3600)*60)*60)
PRINT AT(3,15);"Time: ";h;"h ";m;"m ";s;"s"
PRINT AT(3,18);"SAVING ..."
DELAY 5
RETURN
PROCEDURE transpbx
REM transtom
CLS
RESTORE t11
LOCAL ahaho$,suffix$,zac,t|,lof
LOCAL slava|,trans%,kon,tim,h,m,s,c|
TITLEW #1," January 23, 1996 TRANS --> PBX "
FILESELECT "Select TRANS File","OK","DH3:",ahaho$
c|=1
huh|=82
zac=TIMER
zavertransplus2
CLS
REM tomkoi
RESTORE t22
c|=2
huh|=86
zavertransplus
CLS
REM koipbx
RESTORE t44
suffix$="-PBX"
c|=3
huh|=82
zavertransplus2
kon=TIMER
FRONTS 1
tim=(kon-zac)/200
h=TRUNC(tim/3600)
m=TRUNC(FRAC(tim/3600)*60)
s=INT(FRAC(FRAC(tim/3600)*60)*60)
PRINT AT(3,15);"Time: ";h;"h ";m;"m ";s;"s"
PRINT AT(3,18);"SAVING ..."
DELAY 5
RETURN
PROCEDURE zavertransplus
FOR t|=1 TO huh|
READ john|(t|)
NEXT t|
PRINT AT(3,10);"Transformed characters: "
IF c|=1
OPEN "i",#1,ahaho$
OPEN "o",#2,"RAM:HELP"
PRINT AT(3,23);ahaho$
PRINT AT(3,27);"RAM:HELP"
ELSE IF c|=2
OPEN "i",#1,"RAM:HELP"
OPEN "o",#2,"RAM:HELP2"
PRINT AT(3,23);"RAM:HELP"
PRINT AT(3,27);"RAM:HELP2"
ELSE IF c|=3
OPEN "i",#1,"RAM:HELP2"
OPEN "o",#2,ahaho$+suffix$
PRINT AT(3,23);"RAM:HELP2"
PRINT AT(3,27);ahaho$+suffix$
ENDIF
lof=LOF(#1)
PRINT AT(3,6);"Done % out of total ";lof;" bytes"
DO
slava|=INP(#1)
REM ---------------------- BOD ZMENY
FOR t|=1 TO huh| STEP 2
IF slava|=john|(t|)
slava|=john|(SUCC(t|))
t|=huh|
INC trans%
perc|=INT((100*LOC(#1))/lof)
IF perc|<>percst|
PRINT AT(27,10);trans%;AT(8,6);perc|
percst|=perc|
ENDIF
ENDIF
NEXT t|
OUT #2,slava|
EXIT IF LOC(#1)>=lof
LOOP
PRINT AT(27,10);trans%;AT(8,6);INT((100*LOC(#1))/lof)
CLOSE #2
CLOSE #1
RETURN
PROCEDURE zavertransplus2
FOR t|=1 TO huh|
READ john|(t|)
NEXT t|
PRINT AT(3,10);"Transformed characters: "
IF c|=1
OPEN "i",#1,ahaho$
OPEN "o",#2,"RAM:HELP"
PRINT AT(3,23);ahaho$
PRINT AT(3,27);"RAM:HELP"
ELSE IF c|=2
OPEN "i",#1,"RAM:HELP"
OPEN "o",#2,"RAM:HELP2"
PRINT AT(3,23);"RAM:HELP"
PRINT AT(3,27);"RAM:HELP2"
ELSE IF c|=3
OPEN "i",#1,"RAM:HELP2"
OPEN "o",#2,ahaho$+suffix$
PRINT AT(3,23);"RAM:HELP2"
PRINT AT(3,27);ahaho$+suffix$
ENDIF
lof=LOF(#1)
PRINT AT(3,6);"Done % out of total ";lof;" bytes"
DO
slava|=INP(#1)
REM ---------------------- BOD ZMENY
FOR t|=2 TO huh| STEP 2
IF slava|=john|(t|)
slava|=john|(PRED(t|))
t|=huh|
INC trans%
perc|=INT((100*LOC(#1))/lof)
IF perc|<>percst|
PRINT AT(27,10);trans%;AT(8,6);perc|
percst|=perc|
ENDIF
ENDIF
NEXT t|
OUT #2,slava|
EXIT IF LOC(#1)>=lof
LOOP
PRINT AT(27,10);trans%;AT(8,6);INT((100*LOC(#1))/lof)
CLOSE #2
CLOSE #1
RETURN
REM ---------------------------------------------------------------------------
REM ZA TYMTO RIADKOM BUDU SPOCIVAT VSETKY DATA
REM ---------------------------------------------------------------------------
kalendar:
DATA "MONDAY","TUESDAY","WEDNESDAY","THURSDAY","FRIDAY","SATURDAY","SUNDAY"
DATA 31,28,31,30,31,30,31,31,30,31,30,31
DATA 1,6,5,4,3,1,7,6,5,3,2,1,7,5,4,3,2,7,6,5,4,2,1,7,6,4,3,2
REM --------------------------------------------------------------------------- ```
ENGLISH ARTICLEOCTOBER 20, 2018 AT 01:46:40 UTC