Galaxis: A Calendar and Encrypting Program (GFA Basic, Amiga)

A look at Galaxis running on my AmigaA look at Galaxis running on my Amiga

Galaxis 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 --------------------------------------------------------------------------- ```

Tomáš Fülöpp
Poprad, Slovakia
1993-06
Tomáš Fülöpp (2012)

Parents of this entryParents

Siblings of this entrySiblings

Related linksRelated links

Tagscommodore amigacalendargfa basicencryptionschedulerproject
LanguageENGLISH Content typeARTICLELast updateOCTOBER 20, 2018 AT 01:46:40 UTC