Nostalgična koda

Vse ostalo v zvezi z nostalgijo. Če se bo tega nabralo bomo odprli nov podforum.

Moderator: s55ei

Nostalgična koda

OdgovorNapisal/-a s54mtb » 05 Maj 2017, 17:23

Med iskanjem TEGALE sem naletel na razne kose kode, za katero sem že davno mislil, da je šla v digitalna nebesa. Prilagam primer enega programa iz časov, ko smo se šli še preštevanje bajtov, ki jo zasede strojna koda, da smo stlačili vse skupaj v tistih 4 ali 8k (e)prom-a ali kasneje flasha. To je nastalo v usmerjenem izobraževanju v časih Tita :) Spomnem se pa, da sem to delal za lastno veselje, kot večino stvari še danes.

Konkretno gre za avtomat za zvonenje v cerkvi. Verjetno bi našel tudi datoteke s shemo in tiskanino za TANGO. :mrgreen:

oljd.JPG


Vmes se najdejo zanimivi kosi kode, npr tole(gre za avtomat za zvonenje v cerkvi, kjer lahko zvonijo drugače kadar kdo umre)...

Koda: Izberi vse
L1:    MOV     A,MRLIC
       CJNE    A,#4,L2            ; CE NI PREPOVED ZVONENJA
       CLR     ZVONC
       JMP     L3



Predlagam, da objavite kakšen svoj primerek "nostalgične kode".



Za tiste, ki se jim ne ljubi odpirat ZIP-a:
Koda: Izberi vse
$EP
$PL(65530)
$PW(79)
$NOSB
$TITLE( Zvonomat software (c)1988 by Mare. )

;**************************************************************
; DEFINICIJA SEGMENTOV
;..............................................................
PROG   SEGMENT CODE    ; GLAVNI PROGRAM
STACK  SEGMENT IDATA   ; SKLAD
LCDS   SEGMENT DATA    ; VSEH PET POZICIJ
LEDS   SEGMENT DATA    ; OBOJI INDIKATORJI
GLOBAL SEGMENT DATA    ; GLOBALNE SPREMENLJIVKE
BITI   SEGMENT BIT     ; GLOBALNE ZASTAVICE

;**************************************************************
; DEFINICIJA KONSTANT
;..............................................................
RTCBASE EQU 0010H      ; BAZNA ADRESA ZA RTC
RTC_ST0 EQU 0          ; OFSETI (CIFRE PREPISI IZ PAPIRJEV)  / STOTINKE
RTC_ST1 EQU 0          ; STOTINKE *** CE SO BCD ( POGLEJ V RTC PAPIRJE )
RTC_SEE EQU 0          ; SEKUNDE ENICE
RTC_SED EQU 0          ; SEKUNDE DESETICE
RTC_MIE EQU 0          ; MINUTE ENICE
RTC_MID EQU 0          ; MINUTE DESETICE
RTC_URE EQU 0          ; URE ENICE
RTC_URD EQU 0          ; URE DESETICE
RTC_AM  EQU 0          ; AM / PM
RTC_LEE EQU 0          ; LETO ENICE
RTC_LED EQU 0          ; LETO DESETICE
RTC_DAE EQU 0          ; DAN ENICE
RTC_DAD EQU 0          ; DAN DESETICE
RTC_MEE EQU 0          ; MESEC ENICE
RTC_MED EQU 0          ; MESEC DESETICE
RTC_DVT EQU 0          ; DAN V TEDNU
;    OSTALE SE DODAJ IZ PAPIRJEV ZA RTC
LCD_EN  EQU 0020H      ; ENICE
LCD_DE  EQU 0040H      ; DESETICE
LCD_ST  EQU 0080H      ; STOTICE
LCD_TI  EQU 0100H      ; TISOCICE
LCD_PI  EQU 0200H      ; DECIMALNE PIKE
LCD_BLANK EQU 0FH      ; PRAZNO MESTO NA LCD-ju
PIKA1   EQU 00000010B  ; PRVA PIKA NA LCD-JU
PIKA2   EQU 00000100B
PIKA3   EQU 00001000B
DVOP    EQU 00000001B  ; DVOPICJE
LED     EQU 0400H      ; LED (SINGLE/SKUPNE)
KB_SEL  EQU 0800H      ; TIPKA SELECT
KB_GOR  EQU 1000H      ; TIPKA PUSCICA GOR
KB_LEV  EQU 1800H      ; TIPKA PUSCICA DOL
KB_MAL  EQU 2000H      ; TIPKA ZA MALI ZVON
KB_SRE  EQU 2800H      ; TIPKA ZA SREDNJI ZVON
KB_VEL  EQU 3000H      ; TIPKA ZA VELIKI ZVON
KB_MRL  EQU 3800H      ; TIPKA ZA MRLICA
KBD1    EQU 0800H      ; TASTATURA REZERVA
KBD2    EQU 1000H      ; TASTATURA REZERVA
KBD3    EQU 1800H      ; TASTATURA REZERVA
KBD4    EQU 2000H      ; TASTATURA REZERVA
KBD5    EQU 2800H      ; TASTATURA REZERVA
KBD6    EQU 3000H      ; TASTATURA REZERVA
KB_PRE  EQU 3800H      ; TIPKA ZA PREPOVEDANO ZVONENJE
LED_PRE EQU 1          ; LED ZA PREPOVEDANO ZVONENJE
LED_MR1 EQU 2          ; LED ZA MRLICA1
LED_MR2 EQU 3          ; LED ZA MRLICA2
LED_MR3 EQU 4          ; LED ZA MRLICA3
LED_MAL EQU 00010000B  ; LED ZA MALI ZVON
LED_SRE EQU 00100000B  ; LED ZA SREDNJI ZVON
LED_VEL EQU 01000000B  ; LED ZA VELIKI ZVON
LED_VEC EQU 10000000B  ; LED ZA FOTO RELE
URA     EQU 1          ; NACIN IZPISA - URA
DATUM   EQU 2          ; NACIN IZPISA - DATUM
LETO    EQU 3          ; NACIN IZPISA - LETO
DVTS    EQU 4          ; NACIN IZPISA - DAN V TEDNU IN SEKUNDE
ZVON_M  SET P1.0       ; ZVONENJE - MALI ZVON
ZVON_S  SET P1.1       ; SREDNJI
ZVON_V  SET P1.2       ; VELIKI
DIN     SET P1.4       ; MALI ZA BITJE URE
DON     SET P1.5       ; SREDNJI ZA BITJE URE
BAM     SET P1.6       ; VELIKI ZA BITJE URE
MALI    EQU 1
SREDNJI EQU 2
VELIKI  EQU 4

;**************************************************************
; DEFINICIJA MAKROJEV
;..............................................................

;-------- NASTAVLJANJE CIFRE PRI SETUPU RTC-ja ----------

NC     MACRO   LOKACIJA,MIN,MAX,CIFRA
       LOCAL   LOCAL1
       MOV     DPTR,#LOKACIJA
       MOVX    A,@DPTR
       INC     A
       CJNE    A,#MAX+1,LOCAL1
       MOV     A,#MIN
LOCAL1: MOV    CIFRA,A
       MOVX    @DPTR,A
       ENDM

;-------- TIPKANJE PO TIPKAH ZVONOV -----------------------

KBZVON MACRO   ZVONC,TIPKA,LED
LOCAL  L1,L2,L3,L9

       MOV     DPTR,#TIPKA        ; TIPKA ZA MALI ZVON
       MOVX    A,@DPTR
       JB      ACC.1,L1
       JMP     L9
L1:    MOV     A,MRLIC
       CJNE    A,#4,L2            ; CE NI PREPOVED ZVONENJA
       CLR     ZVONC
       JMP     L3
L2:    CPL     ZVON_M
       MOV     A,DIREKT
       CPL     ACC.LED            ; LED ZA MALI ZVON
       MOV     DIREKT,A
L3:    MOV     DPTR,#TIPKA
       MOVX    A,@DPTR
       JB      ACC.1,L3
L9:
       ENDM

; ------ RAZPAKIRANJE BCD CIFRE ZA CASOVNE SPREMENLJIVKE
;                +------------------ OFSET ZA RTC - BRANJE ENIC
;                |      +-----------    - " -     - BRANJE DESETIC
;                |      |     +----- REGISTER, V KATEREM NAJ BO REZULTAT
;                |      |     |

UNPACK MACRO   OFSETE,OFSETD,REG
       MOV     DPTR,#RTCBASE+OFSETD
       MOVX    A,@DPTR            ; PREBERI DESETICE
       MOV     B,#10
       MUL     AB                 ; POMNOZI Z DESET
       MOV     REG,A
       MOV     DPTR,#RTCBASE+OFSETE
       MOVX    A,@DPTR            ; PREBERI ENICE
       ADD     A,REG
       MOV     REG,A              ; PRISTEJ K DESETICAM
       ENDM

;               +------------------- TRAJANJE V MINUTAH
;               |   +--------------- TRAJANJE V SEKUNDAH
;               |   |   +----------- KOMBINACIJA NA IZHODU
;               |   |   |
ZVON   MACRO   MIN,SEK,PORT
LOCAL  L1,L2,L3

       MOV     P1,#PORT           ; NASTAVI ZVONOVE
       CJNE    MIN,#0,L2          ; CE SO SAMO SEKUNDE
       INC     MIN                ; ZA DJNZ
L1:    MOV     R6,#0
       CJNE    R6,#59,$           ; PAVZA ENA MINUTA
       DJNZ    MIN,L1             ; ODSTEVANJE MINUT
L2:    MOV     R6,0
       MOV     PRIM,SEK
L3:    MOV     A,R6
       CJNE    A,PRIM,L3         ; PAVZA OSTANKA SEKUND
       MOV     P1,#0              ; KONEC ZVONENJA
       ENDM


;**************************************************************
; SKLAD
;..............................................................
       RSEG    STACK
       DS      30

;**************************************************************
; PODATKOVNI SEGMENT ZA IZPIS NA LCD-JU
;..............................................................
       RSEG    LCDS
ZALCD: DS      5
       ENI     DATA ZALCD
       DES     DATA ZALCD+1
       STO     DATA ZALCD+2
       TIS     DATA ZALCD+3
       PIK     DATA ZALCD+4

;**************************************************************
; PODATKOVNI SEGMENT ZA LED INDIKATORJE
;..............................................................
       RSEG    LEDS
ZALED: DS      1
       DIREKT  DATA ZALED

;**************************************************************
; PODATKOVNI SEGMENT ZA GLOBALNE SPREMENLJIVKE
;..............................................................
       RSEG    GLOBAL
GLOB:  DS      5
       IZPISM  DATA GLOB          ; NACIN IZPISA :
                                    ; 1 = URE + MINUTE
                                    ; 2 = DATUM
                                    ; 3 = LETO
                                    ; 4 = DAN V TEDNU + SEKUNDE
       BLINKA  DATA GLOB+1        ; KATERA CIFRA NA LCD BLINKA?
                                    ; 1,2,3,4 = ENA OD STIRIH
                                    ; 5 = DVOPICJE
                                    ; 0 = NOBENA
       LETOXX  DATA GLOB+2        ; SPAKIRAN BCD ZA LETO (19XX)
       MRLIC   DATA GLOB+3        ; TIP MRLICA
                                    ; 0 = NI MRLICA
                                    ; 1 = MRLIC OTROK
                                    ; 2 = MRLIC MOSKI
                                    ; 3 = MRLIC ZENSKA
                                    ; 4 = NI ZVONENJA
       PRIM    DATA GLOB+4        ; SPLOSNA SPREMENLJIVKA

;**************************************************************
; PODATKOVNI SEGMENT ZA GLOBALNE BITNE SPREMENLJIVKE
;..............................................................
       RSEG    BITI
BBBB:  DBIT    2
       BLINKER BIT BBBB
       FOTO    BIT BBBB+1

;**************************************************************
; ZACETEK PROGRAMA
;..............................................................
       CSEG    AT 0
       USING   0

       LJMP    START                 ; RESET VEKTOR
       DB      'BIM-BAM (C)1992'
       DB      ' by Mare.'           ; GAP
       LJMP    INTT1                 ; INTT1 VEKTOR

       RSEG    PROG
START: MOV     SP,#STACK-1

       MOV     TMOD,#01100000B       ; COUNTER1, MODE2
       MOV     TH1,#256-8            ; ö 8  ZA T1 VHOD
       MOV     TL1,#256-8            ; IN KLIC INTT1 VSAKO STOTINKO
       MOV     R6,#0                 ; SEKUNDE ZA CAKALNE ZANKE
       MOV     R7,#0                 ; STOTINKE ZA CAKALNE ZANKE
       SETB    ET1
       SETB    PT1
       SETB    TR1
       SETB    P3.5                  ; SPROSTI PULLUP ZA IRQ-T1
       SETB    EA                    ; POZENI MASINERIJO
       CALL    SELF
       MOV     IZPISM,#URA           ; NACIN IZPISA = URA
       MOV     BLINKA,#5             ; BLINKANJE DVOPICJA
       SETB    BLINKER               ; VKLJUCI DVOPICJE
       MOV     LETOXX,19H            ; ENTISOCDEVETSTO
       CLR     FOTO                  ; VECERNEGA ZVONENJA SE NI BILO
       MOV     MRLIC,#0              ; DOVOLJENOZVONENJE, BREZ MRLICA
       MOV     P1,#0                 ; BRISI IZHODE
       MOV     DIREKT,#0             ; BRISI LED

;..............................................................
; GLAVNA ZANKA
;..............................................................

;-----------  NASTAVITVE VREDNOSTI ZA IZPIS NA LCD-ju ---------

ZAN00: CALL    UPDATE             ; OSVEZITEV IZPISA
       CALL    KEYBOARD           ; PREGLEJ TIPKE IN NASTAVI
       CALL    UPDATE
       CALL    BITJEURE           ; BITJE - URA
       CALL    UPDATE
       CALL    ZVONENJE           ; ZVONENJE
       JMP     ZAN00

;**************************************************************
;******************   PODPROGRAMI   ***************************
;**************************************************************

;**************************************************************
; BRANJE URE :
;                   R0 : SEKUNDE
;                   R1 : MINUTE
;                   R2 : URE
;..............................................................

TIME:  UNPACK  RTC_SEE,RTC_SED,R0
       UNPACK  RTC_MIE,RTC_MID,R1
       UNPACK  RTC_URE,RTC_URD,R2
       RET

;**************************************************************
; BRANJE DATUMA
;                   R0 : DAN
;                   R1 : MESEC
;                   R2 : DAN V TEDNU
;..............................................................

DATE:  UNPACK  RTC_DAE,RTC_DAD,R0
       UNPACK  RTC_MEE,RTC_MED,R1
       MOV     DPTR,#RTCBASE+RTC_DVT   ; DAN V TEDNU
       MOVX    A,@DPTR
       MOV     R2,A
       RET

;**************************************************************
; ZVONENJE ZVONOV OB DOLOCENI URI, MINUTI IN SEKUNDI IN SEVEDA
; DOLOCENEM DATUMU IN NE OB PREPOVEDI ZVONENJA ITD...
;..............................................................

ZVONENJE:
       RET     ; ZAENKRAT JE SE PRAZNO

;**************************************************************
; AVE : SREDNJI VELKI MALI
;..............................................................

AVE1   EQU 1                      ; DOLZINA V MINUTAH ZA POSAMEZNI ZVON
AVE2   EQU 59                     ; DOLZINA V SEKUNDAH
AVE3   EQU 0                      ; DOLZINA V MINUTAH ZA PAVZO
AVE4   EQU 25                     ; DOLZINA V SEKUNDAH ZA PAVZO

AVE:   MOV     R4,AVE1
       MOV     R5,AVE2
       ZVON    R4,R5,SREDNJI      ; IMPULZ
       MOV     R4,AVE3
       MOV     R5,AVE4
       ZVON    R4,R5,0            ; PAVZA
       MOV     R4,AVE1
       MOV     R5,AVE2
       ZVON    R4,R5,VELIKI       ; IMPULZ
       MOV     R4,AVE3
       MOV     R5,AVE4
       ZVON    R4,R5,0            ; PAVZA
       MOV     R4,AVE1
       MOV     R5,AVE2
       ZVON    R4,R5,MALI         ; IMPULZ
       MOV     R4,AVE3
       MOV     R5,AVE4
       ZVON    R4,R5,0            ; PAVZA
       RET

;**************************************************************
; VSI : Z VSEMI TREMI
;..............................................................

VSI1   EQU 2                      ; TRAJANJE V MIN
VSI2   EQU 59                     ; TRAJANJE V SEK
VSI3   EQU 0                      ; PAVZA V MIN
VSI4   EQU 40                     ; PAVZA V SEK

VSI:   MOV     R4,VSI1
       MOV     R5,VSI2
       ZVON    R4,R5,MALI         ; IMPULZ
       MOV     R4,VSI3
       MOV     R5,VSI4
       ZVON    R4,R5,0            ; PAVZA
       RET

;**************************************************************
; VELI : SAMO VELIKI
;..............................................................

VELI1  EQU 2                      ; TRAJANJE V MIN
VELI2  EQU 59                     ; TRAJANJE V SEK
VELI3  EQU 0                      ; PAVZA V MIN
VELI4  EQU 40                     ; PAVZA V SEK

VELI:  MOV     R4,VELI1
       MOV     R5,VELI2
       ZVON    R4,R5,MALI         ; IMPULZ
       MOV     R4,VELI3
       MOV     R5,VELI4
       ZVON    R4,R5,0            ; PAVZA
       RET

;**************************************************************
; BITJE URE, VSI DIN DONi IN BAMi
;..............................................................

BITJEURE:
       CALL    TIME
       CJNE    R0,#0,GLC1A
       CJNE    R1,#0,GLC0         ; POLNA URA
       CALL    FIRKELC            ; STIRJE FIRKELCI
       CALL    FIRKELC
       CALL    FIRKELC
       CALL    FIRKELC
       CALL    ODBIJ              ; URA
GLC1A: JMP     GLC1               ; IZHOD
GLC0:  CJNE    R1,#15,GLC2
       CALL    FIRKELC            ; CETRT URE
       JMP     GLC1
GLC2:  CJNE    R1,#30,GLC3        ;  /
       CALL    FIRKELC            ; POL
       CALL    FIRKELC
       JMP     GLC1
GLC3:  CJNE    R1,#45,GLC1
       CALL    FIRKELC            ; TRICETRT
       CALL    FIRKELC
       CALL    FIRKELC
GLC1:  RET


;**************************************************************
; ODBITJE URE, URA JE V R2
;..............................................................
BOMPULSE       EQU 10             ; DOLZINA BOM-A V msec
PAVZABAM1      EQU 50             ; PAVZA MED BOMI - msec
PAVZABAM2      EQU 1              ; PAVZA MED BOMI - sek
PAVZABAM0A     EQU 90             ; PAVZA PRED BITJEM - msec
PAVZABAM0B     EQU 0              ; PAVZA PRED BITJEM - sek

ODBIJ: CJNE    R2,#12,ODB2
       JMP     ODB1               ; CE JE POLDNE
ODB2:  JC      ODB3               ; CE JE MANJ OD POLDNE
       MOV     A,R2
       SUBB    A,#12              ; ODSTEJ POLDNE
       MOV     R2,A
       JMP     ODB1               ; IN ODBIJ
ODB3:  CJNE    R2,#0,ODB1         ; CE NI POLNOC
       MOV     R2,#12             ; SICER ODBIJ 12-KRAT
ODB1:  MOV     R6,#0
       CJNE    R6,#PAVZABAM0B,$   ; PAVZA PRED BITJEM
       MOV     R7,#0
       CJNE    R7,#PAVZABAM0A,$
ODB0:  SETB    BAM                ; IMPULZEK
       MOV     R7,#0              ;             __
       CJNE    R7,#BOMPULSE,$     ; DOLZINA ___/  \___
       CLR     BAM
       MOV     R6,#0              ; PAVZA MED IMPULZKI
       CJNE    R6,#PAVZABAM2,$
       MOV     R7,#0
       CJNE    R7,#PAVZABAM1,$
       DJNZ    R2,ODB0
       RET

;**************************************************************
; FIRKELC - DIN DON
;..............................................................

DINPULSE       EQU 10             ; DOLZINA DIN IMPULZA V msec
DINPAVZA1      EQU 40             ; PAVZA MED DIN IN DON - msec
DINPAVZA2      EQU 0              ; PAVZA MED DIN IN DON - sek
DONPULSE       EQU 10             ; DOLZINA DIN IMPULZA V msec
DONPAVZA1      EQU 40             ; PAVZA MED DINDONI - msec
DONPAVZA2      EQU 0              ; PAVZA MED DINDONI - sek

FIRKELC:
       SETB    DIN
       MOV     R7,#0
       CJNE    R7,#DINPULSE,$
       CLR     DIN
       MOV     R6,#0
       CJNE    R6,#DINPAVZA1,$
       MOV     R7,#0
       CJNE    R7,#DINPAVZA2,$
       SETB    DON
       MOV     R7,#0
       CJNE    R7,#DONPULSE,$
       CLR     DON
       MOV     R6,#0
       CJNE    R6,#DONPAVZA1,$
       MOV     R7,#0
       CJNE    R7,#DONPAVZA2,$
       RET

;**************************************************************
; UPDATE INTERNIH SPREMENLJIVK ZA URO
;..............................................................

UPDATE:
       MOV     A,IZPISM
       CJNE    A,#URA,GL01
       MOV     DPTR,#RTCBASE+RTC_URE ; NASTAVITEV VREDNOSTI ZA
       MOVX    A,@DPTR               ; IZPIS URE
       MOV     STO,A
       MOV     DPTR,#RTCBASE+RTC_URD
       MOVX    A,@DPTR
       MOV     TIS,A
       MOV     DPTR,#RTCBASE+RTC_MIE ; MINUTE
       MOVX    A,@DPTR
       MOV     ENI,A
       MOV     DPTR,#RTCBASE+RTC_MID
       MOVX    A,@DPTR
       MOV     DES,A
       MOV     PIK,#DVOP
       MOV     BLINKA,#5             ; BLINKA DVOPICJE

GL01:  CJNE    A,#DATUM,GL02
       MOV     DPTR,#RTCBASE+RTC_MEE ; NASTAVITEV VREDNOSTI ZA
       MOVX    A,@DPTR               ; IZPIS DATUMA - MESEC
       MOV     STO,A
       MOV     DPTR,#RTCBASE+RTC_MED
       MOVX    A,@DPTR
       MOV     TIS,A
       MOV     DPTR,#RTCBASE+RTC_DAE ; DAN
       MOVX    A,@DPTR
       MOV     ENI,A
       MOV     DPTR,#RTCBASE+RTC_DAD
       MOVX    A,@DPTR
       MOV     DES,A
       MOV     PIK,#PIKA2

GL02:  CJNE    A,#LETO,GL03
       MOV     DPTR,#RTCBASE+RTC_LEE ; NASTAVITEV VREDNOSTI ZA
       MOVX    A,@DPTR               ; IZPIS LETA
       MOV     ENI,A
       MOV     DPTR,#RTCBASE+RTC_LED
       MOVX    A,@DPTR
       MOV     DES,A
       MOV     A,LETOXX
       ANL     A,00001111B
       MOV     STO,A
       MOV     A,LETOXX
       SWAP    A
       ANL     A,00001111B
       MOV     TIS,A
       MOV     PIK,#0

GL03:  CJNE    A,#DVTS,GL04
       MOV     DPTR,#RTCBASE+RTC_SEE ; NASTAVITEV VREDNOSTI ZA
       MOVX    A,@DPTR               ; IZPIS SEKUND
       MOV     ENI,A
       MOV     DPTR,#RTCBASE+RTC_SED
       MOVX    A,@DPTR
       MOV     DES,A
       MOV     STO,#LCD_BLANK
       MOV     DPTR,#RTCBASE+RTC_DVT ; IZPIS DNEVA V TEDNU
       MOVX    A,@DPTR
       MOV     TIS,A
       MOV     PIK,#DVOP+PIKA2
GL04:  RET

;**************************************************************
; KEYBOARD - OBDELAVA TIPK
;..............................................................

KEYBOARD:
       MOV     DPTR,#KB_SEL
       MOVX    A,@DPTR
       JB      ACC.1,GL06
       JMP     GL07               ; NI TIPKA SEL
GL06:                             ; SETUP RTC-JA CE JE PRITISNJENA TIPKA SEL
       MOV     BLINKA,#0          ; NIC NE BLINKA
       MOV     A,IZPISM

;************************* URA
       CJNE    A,#URA,GL24
       JMP     GL23
GL24:  JMP     GL08
GL23:  MOV     BLINKA,#1          ; SETUP URE
GL15:  MOV     DPTR,#KB_LEV
       MOVX    A,@DPTR
       JB      ACC.1,GL12         ; TIPKA LEVO
       MOV     DPTR,#KB_GOR
       MOVX    A,@DPTR
       JB      ACC.1,GL13         ; TIPKA GOR
       MOV     DPTR,#KB_SEL
       MOVX    A,@DPTR
       JB      ACC.1,GL14         ; TIPKA SET = IZHOD
       JMP     GL15               ; VSE V ZANKI
GL14:  JMP     GL07               ; IZHOD
GL12:  INC     BLINKA             ; SPREMENI CIFRO
       MOV     A,BLINKA
       CJNE    A,#5,GL16
       JMP     GL17
GL16:  MOV     BLINKA,#1          ; Z IZBIRO CIFRE SMO OKROG
GL17:  MOV     R7,#0
GL18:  MOV     DPTR,#KB_LEV
       MOVX    A,@DPTR
       JNB     ACC.1,GL15         ; SPUSCENA TIPKA - VRNITEV V ZANKO
       CJNE    R7,#50,GL18        ; SICER POL SEKUNDE PAVZE
       JMP     GL15               ; IN POTEM VRNITEV V ZANKO
GL13:  MOV     A,BLINKA           ; KATERO CIFRO NASTAVLJAM?
       CJNE    A,#1,GL19
       NC      RTCBASE+RTC_MIE,0,9,ENI
GL19:  CJNE    A,#2,GL20          ; NI DRUGA
       NC      RTCBASE+RTC_MID,0,5,DES
GL20:  CJNE    A,#3,GL21          ; NI TRETJA
       NC      RTCBASE+RTC_URE,0,9,STO
GL21:                             ; POTEM JE CETRTA
       NC      RTCBASE+RTC_URD,0,2,TIS
       MOV     R7,#0
GL22:  MOV     DPTR,#KB_GOR
       MOVX    A,@DPTR
       JNB     ACC.1,GL15         ; NI PRITISNJENA- VRNITEV V ZANKO
       CJNE    R7,#50,GL22        ; SICER PAVZA
       JMP     GL15               ; PO PAVZI VRNITEV

;**************************** DATUM
GL08:  CJNE    A,#DATUM,GL44
       JMP     GL43
GL44:  JMP     GL08
GL43:  MOV     BLINKA,#1
GL35:  MOV     DPTR,#KB_LEV
       MOVX    A,@DPTR
       JB      ACC.1,GL32         ; TIPKA LEVO
       MOV     DPTR,#KB_GOR
       MOVX    A,@DPTR
       JB      ACC.1,GL33         ; TIPKA GOR
       MOV     DPTR,#KB_SEL
       MOVX    A,@DPTR
       JB      ACC.1,GL34         ; TIPKA SET = IZHOD
       JMP     GL35               ; VSE V ZANKI
GL34:  JMP     GL07               ; IZHOD
GL32:  INC     BLINKA             ; SPREMENI CIFRO
       MOV     A,BLINKA
       CJNE    A,#5,GL36
       JMP     GL37
GL36:  MOV     BLINKA,#1          ; Z IZBIRO CIFRE SMO OKROG
GL37:  MOV     R7,#0
GL38:  MOV     DPTR,#KB_LEV
       MOVX    A,@DPTR
       JNB     ACC.1,GL35         ; SPUSCENA TIPKA - VRNITEV V ZANKO
       CJNE    R7,#50,GL38        ; SICER POL SEKUNDE PAVZE
       JMP     GL35               ; IN POTEM VRNITEV V ZANKO
GL33:  MOV     A,BLINKA           ; KATERO CIFRO NASTAVLJAM?
       CJNE    A,#1,GL39
       NC      RTCBASE+RTC_DAE,0,9,ENI
GL39:  CJNE    A,#2,GL40          ; NI DRUGA
       NC      RTCBASE+RTC_DAD,0,5,DES
GL40:  CJNE    A,#3,GL41          ; NI TRETJA
       NC      RTCBASE+RTC_MEE,0,9,STO
GL41:                             ; POTEM JE CETRTA
       NC      RTCBASE+RTC_MED,0,2,TIS
       MOV     R7,#0
GL42:  MOV     DPTR,#KB_GOR
       MOVX    A,@DPTR
       JNB     ACC.1,GL35         ; NI PRITISNJENA- VRNITEV V ZANKO
       CJNE    R7,#50,GL42        ; SICER PAVZA
       JMP     GL35               ; PO PAVZI VRNITEV

GL09:  CJNE    A,#LETO,GL10
       JMP     GL11
GL10:                             ; SETUP DVT+SEKUNDE
       MOV     BLINKA,#1
GL55:  MOV     DPTR,#KB_LEV
       MOVX    A,@DPTR
       JB      ACC.1,GL52         ; TIPKA LEVO
       MOV     DPTR,#KB_GOR
       MOVX    A,@DPTR
       JB      ACC.1,GL53         ; TIPKA GOR
       MOV     DPTR,#KB_SEL
       MOVX    A,@DPTR
       JB      ACC.1,GL54         ; TIPKA SET = IZHOD
       JMP     GL55               ; VSE V ZANKI
GL54:  JMP     GL07               ; IZHOD
GL52:  INC     BLINKA             ; SPREMENI CIFRO
       MOV     A,BLINKA
       CJNE    A,#3,GL56
       JMP     GL69
GL56:  CJNE    A,#4,GL57
       MOV     BLINKA,#1          ; Z IZBIRO CIFRE SMO OKROG
       JMP     GL57
GL69:  MOV     BLINKA,#4
GL57:  MOV     R7,#0
GL58:  MOV     DPTR,#KB_LEV
       MOVX    A,@DPTR
       JNB     ACC.1,GL55         ; SPUSCENA TIPKA - VRNITEV V ZANKO
       CJNE    R7,#50,GL58        ; SICER POL SEKUNDE PAVZE
       JMP     GL55               ; IN POTEM VRNITEV V ZANKO
GL53:  MOV     A,BLINKA           ; KATERO CIFRO NASTAVLJAM?
       CJNE    A,#1,GL59
       NC      RTCBASE+RTC_SEE,0,9,ENI
GL59:  CJNE    A,#2,GL61          ; NI DRUGA
       NC      RTCBASE+RTC_SED,0,5,DES
GL61:                             ; POTEM JE CETRTA
       NC      RTCBASE+RTC_DVT,0,6,TIS
       MOV     R7,#0
GL62:  MOV     DPTR,#KB_GOR
       MOVX    A,@DPTR
       JNB     ACC.1,GL55         ; NI PRITISNJENA- VRNITEV V ZANKO
       CJNE    R7,#50,GL62        ; SICER PAVZA
       JMP     GL55               ; PO PAVZI VRNITEV


GL11:                             ; SETUP LETA
GL83:  MOV     BLINKA,#1
GL75:  MOV     DPTR,#KB_LEV
       MOVX    A,@DPTR
       JB      ACC.1,GL72         ; TIPKA LEVO
       MOV     DPTR,#KB_GOR
       MOVX    A,@DPTR
       JB      ACC.1,GL73         ; TIPKA GOR
       MOV     DPTR,#KB_SEL
       MOVX    A,@DPTR
       JB      ACC.1,GL74         ; TIPKA SET = IZHOD
       JMP     GL75               ; VSE V ZANKI
GL74:  JMP     GL07               ; IZHOD
GL72:  INC     BLINKA             ; SPREMENI CIFRO
       MOV     A,BLINKA
       CJNE    A,#5,GL76
       JMP     GL77
GL76:  MOV     BLINKA,#1          ; Z IZBIRO CIFRE SMO OKROG
GL77:  MOV     R7,#0
GL78:  MOV     DPTR,#KB_LEV
       MOVX    A,@DPTR
       JNB     ACC.1,GL75         ; SPUSCENA TIPKA - VRNITEV V ZANKO
       CJNE    R7,#50,GL78        ; SICER POL SEKUNDE PAVZE
       JMP     GL75               ; IN POTEM VRNITEV V ZANKO
GL73:  MOV     A,BLINKA           ; KATERO CIFRO NASTAVLJAM?
       CJNE    A,#1,GL79
       NC      RTCBASE+RTC_LEE,0,9,ENI
GL79:  CJNE    A,#2,GL80          ; NI DRUGA
       NC      RTCBASE+RTC_LED,0,9,DES
GL80:  CJNE    A,#3,GL81          ; NI TRETJA
       MOV     A,LETOXX
       ADD     A,#01
       DA      A
       CJNE    A,#20H,GL89
       MOV     A,#19H
GL89:  MOV     LETOXX,A
       ANL     A,#00001111B
       MOV     STO,A
       MOV     A,LETOXX
       ANL     A,#11110000B
       SWAP    A
       MOV     TIS,A
GL81:  MOV     A,LETOXX           ; CETRTA CIFRA ( TISOCICE LETA )
       ADD     A,#10H
       DA      A
       CJNE    A,#20H,GL88
       MOV     A,#19H
GL88:  MOV     LETOXX,A
       ANL     A,#00001111B
       MOV     STO,A
       MOV     A,LETOXX
       ANL     A,#11110000B
       SWAP    A
       MOV     TIS,A

       MOV     R7,#0
GL82:  MOV     DPTR,#KB_GOR
       MOVX    A,@DPTR
       JNB     ACC.1,GL87         ; NI PRITISNJENA- VRNITEV V ZANKO
       CJNE    R7,#50,GL82        ; SICER PAVZA
GL87:  JMP     GL75               ; PO PAVZI VRNITEV
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

GL07:  MOV     DPTR,#KB_GOR       ; SKOK SEM, CE NI PRITISNJENA TIPKA SEL
       MOVX    A,@DPTR            ; IN POTEM TEST ZA TIPKO "GOR" => SPREMEMBA
       JB      ACC.1,GL90         ; IZPISA
       JMP     GLA0
GL90:  INC     IZPISM
       MOV     A,IZPISM
       CJNE    A,#5,GL91
       MOV     IZPISM,#1
       MOV     R7,#0
GL91:  MOV     DPTR,#KB_GOR
       MOVX    A,@DPTR
       JNB     ACC.1,GLA0         ; CE NI VEC PRITISNJENA - IZHOD
       CJNE    R7,#50,GL91        ; PAVZA ZA AUTOREPEAT

GLA0:  MOV     DPTR,#KB_MRL       ; TIPKA ZA MRLICA
       MOVX    A,@DPTR
       JB      ACC.1,GLA1
       JMP     GLB0
GLA1:  INC     MRLIC
       MOV     A,MRLIC
       CJNE    A,#4,GLA2
       MOV     A,#0
GLA2:  MOV     MRLIC,A
GLA3:  MOV     DPTR,#KB_GOR
       MOVX    A,@DPTR
       JB      ACC.1,GLA3         ; POCAKAJ, DA BO TIPKA SPROSCENA

GLB0:  KBZVON  ZVON_M,KB_MAL,4    ; MACRO ZA TIPKE ZVONOV
       KBZVON  ZVON_S,KB_SRE,5
       KBZVON  ZVON_V,KB_VEL,6

GLB1:  MOV     DPTR,#KB_PRE       ; TIPKA ZA PREPOVEDANO ZVONENJE
       MOVX    A,@DPTR
       JB      ACC.0,GLB3
       JMP     GLB2
GLB3:  MOV     A,MRLIC
       CJNE    A,#4,GLB4          ; STANJE OD PREJ
       MOV     MRLIC,#0           ; DOVOLI SPET ZVONENJE
       JMP     GLB5
GLB4:  MOV     MRLIC,#4
       ANL     P1,#11110000B      ; BRISI IZHODE ZA ZVONENJE, BITJE OSTANE
GLB5:  MOV     R7,#0
GLB6:  MOV     DPTR,#KB_PRE
       MOVX    A,@DPTR
       JNB     ACC.0,GLB2
       CJNE    R7,#50,GLB6

GLB2:  RET


;**************************************************************
; SELF TEST OB ZAGONU
;..............................................................
SELF:  MOV     R0,#0
SELF1: MOV     ENI,R0               ; NAJPREJ LCD
       MOV     DES,R0
       MOV     STO,R0
       MOV     TIS,R0
       MOV     PIK,R0
       INC     R0
       MOV     R7,#0
SELF0: CJNE    R7,#25,SELF0         ; 1/4 SEKUNDE
       INC     R0
       CJNE    R0,#15,SELF1
       MOV     DIREKT,#LED_MAL      ; POTEM SE LED
       MOV     MRLIC,#LED_PRE
       MOV     R7,#0
SELF2: CJNE    R7,#25,SELF2         ; 1/4 SEKUNDE
       MOV     DIREKT,#LED_SRE
       MOV     MRLIC,#LED_MR1
       MOV     R7,#0
SELF3: CJNE    R7,#25,SELF3         ; 1/4 SEKUNDE
       MOV     DIREKT,#LED_VEL
       MOV     MRLIC,#LED_MR2
       MOV     R7,#0
SELF4: CJNE    R7,#25,SELF4         ; 1/4 SEKUNDE
       MOV     DIREKT,#LED_VEC
       MOV     MRLIC,#LED_MR3
       MOV     R7,#0
SELF5: CJNE    R7,#25,SELF5         ; 1/4 SEKUNDE
       MOV     DIREKT,#0            ; SE POBRISI ZA SABO
       MOV     MRLIC,#0
       MOV     ENI,#0
       MOV     DES,#0
       MOV     STO,#0
       MOV     TIS,#0
       MOV     PIK,#0
       RET

;**************************************************************
; INTERRUPT T1
;..............................................................
INTT1: PUSH    PSW
       PUSH    ACC
       PUSH    B
       PUSH    DPL
       PUSH    DPH
       INC     R7                 ; STOTINKE
       CJNE    R7,#50,T1L9
       CPL     BLINKER
T1L9:  CJNE    R7,#100,T1L0
       MOV     R7,#0
T1L0:  INC     R6                 ; SEKUNDE
       CJNE    R6,#60,T1L1
       MOV     R6,#0

T1L1:  MOV     A,BLINKA
       CJNE    A,#1,T1L2
       MOV     DPTR,#LCD_EN
       JB      BLINKER,T1L1A
       MOV     A,ENI
       JMP     T1L1B
T1L1A: MOV     A,LCD_BLANK
T1L1B: MOVX    @DPTR,A

T1L2:  MOV     A,BLINKA
       CJNE    A,#2,T1L3
       MOV     DPTR,#LCD_DE
       JB      BLINKER,T1L2A
       MOV     A,DES
       JMP     T1L2B
T1L2A: MOV     A,LCD_BLANK
T1L2B: MOVX    @DPTR,A

T1L3:  MOV     A,BLINKA
       CJNE    A,#3,T1L4
       MOV     DPTR,#LCD_ST
       JB      BLINKER,T1L3A
       MOV     A,STO
       JMP     T1L3B
T1L3A: MOV     A,LCD_BLANK
T1L3B: MOVX    @DPTR,A

T1L4:  MOV     A,BLINKA
       CJNE    A,#4,T1L5
       MOV     DPTR,#LCD_TI
       JB      BLINKER,T1L4A
       MOV     A,TIS
       JMP     T1L4B
T1L4A: MOV     A,LCD_BLANK
T1L4B: MOVX    @DPTR,A

T1L5:  MOV     A,BLINKA
       CJNE    A,#5,T1L6
       MOV     DPTR,#LCD_PI
       JB      BLINKER,T1L5A
       MOV     A,PIK
       JMP     T1L5B
T1L5A: MOV     A,LCD_BLANK
T1L5B: MOVX    @DPTR,A

T1L6:  MOV     DPTR,#LCD_EN       ; CE NE BLINKA, SAMO IZPIS
       MOV     A,ENI
       MOVX    @DPTR,A
       MOV     DPTR,#LCD_DE
       MOV     A,DES
       MOVX    @DPTR,A
       MOV     DPTR,#LCD_ST
       MOV     A,STO
       MOVX    @DPTR,A
       MOV     DPTR,#LCD_TI
       MOV     A,TIS
       MOVX    @DPTR,A
       MOV     DPTR,#LCD_PI
       MOV     A,PIK
       MOVX    @DPTR,A

       MOV     A,DIREKT           ; UPDATE ZA LED
       ORL     A,MRLIC            ; DODAJ ENOJNE LED
       MOV     DPTR,#LED
       MOVX    @DPTR,A
       POP     DPH
       POP     DPL
       POP     B
       POP     ACC
       POP     PSW
       RETI

       END
s54mtb
 
Prispevkov: 6078
Pridružen: 15 Jan 2015, 01:10
Zahvalil se je: 823 krat
Prejel zahvalo: 1891 krat
Uporabnika povabil: Vrtni palček
Število neizkoriščenih povabil: 23

Re: Nostalgična koda

OdgovorNapisal/-a Kroko » 06 Maj 2017, 06:00

Moj prvi "program" je bila igrica za zx spectrum. Naredil sem labirint v katerem je junak pobiral fižolčke. Tudi na Amigi sem delal igrice, razbijanje zidu z kroglico. Zanimivo, da sem v moji šoli objektnega programiranja učil kako se sprogramira igro "asteroids"
S prijateljem (on je skrbel za grafiko) sva naredila on line mrežno igro v kateri so igralci kupovali nadgradnje in dodatne stopnje. To je bilo več let preden smo podobne vzorce sploh opazili.

Tudi aplikacijo za hrambo podatkov sem izumil preden sem vedel kaj pomenu beseda 'oblak". Verjetno to aplikacijo nevede večina uporablja saj jo ima večina bank.

V CNC sem tudi zašel povsem naključno. Programa, ki sem ga napisal za rezanje kril, nisem več znal uporabljati in sem poguglal gkodo...

Žal iz zx in amiga časov ne obstaja nič več. Imam pa vse iz pc obdobja.

PS
Še do konca meseca sem na telefonu. Prosim moderatorje, da mi pomagajo pri pravopisu. Imam občutek, da bi telefon želel tipkati po svoje in težko najdem napake.
http://www.planet-cnc.comKroko was here!
Uporabniški avatar
Kroko
 
Prispevkov: 3127
Pridružen: 14 Jan 2015, 12:12
Kraj: Ljubljana
Zahvalil se je: 545 krat
Prejel zahvalo: 1029 krat
Uporabnika povabil: Vrtni palček
Število neizkoriščenih povabil: 185

Re: Nostalgična koda

OdgovorNapisal/-a VolkD » 06 Maj 2017, 09:14

Kroko je napisal/-a:PS
Še do konca meseca sem na telefonu. Prosim moderatorje, da mi pomagajo pri pravopisu. Imam občutek, da bi telefon želel tipkati po svoje in težko najdem napake.
done.
Dokler bodo ljudje mislili, da živali ne čutijo bolečine, bodo živali čutile, da ljudje ne mislijowww.S5tech.net
Uporabniški avatar
VolkD
Administratorji strani
 
Prispevkov: 19047
Pridružen: 29 Dec 2014, 20:49
Kraj: Kačiče (Divača)
Zahvalil se je: 3397 krat
Prejel zahvalo: 2706 krat
Uporabnika povabil: Vrtni palček
Število neizkoriščenih povabil: 255

Re: Nostalgična koda

OdgovorNapisal/-a VolkD » 06 Maj 2017, 09:31

Ne vem če se je kaj ohranilo iz ZX časov razen to kar je bilo na 1.slovenski kaseti za ta mlinček.
Glede na to, da sem Spektrumov ROM poznal skoraj na pamet sem si privoščil narediti debuger za spektrumov basic. Poimenoval sem ga ZX SPECTRUM TRACER. Pred kakimi osmimi leti sem imel ponovno priložnost delati na Spektrumu in takrat sem privlekel vso svojo zalogo kaset. Po enem popoldnevi in večeru sem obupal. Vse kar sem uspel naložiti s teh kaset je bil en star precej slab šah. Ostalo je bilo neberljivo. Z gotovostjo torej lahko trdim, da je source izgubljen.

Drug tak program, ki je prav tako (vsaj mislim) izgubljen je program, ki zna določiti proizvajalca Z80 procesorja.
Z80 je procesor, ki se ko pride nelegalna kombinacija bitov v instrukcijski kodi, obnaša nedefinirano, a pri različnih proizvajalcih drugače v posameznih skritih bitih. V tistih časih se je te nedokumentirane instrukcije skrivalo, ker so bile osnova za zaščito proti kopiranju programov. Danes se o tem ve veliko - nedokumentirane instrukcije.
No na ZX spectrumu, bi se dalo narediti precej več zanimivih stvari, če bi ne bila v ROM-u narejena groba napaka (zanalašč?). Že na drugem mestu tabele prekinitvenih vektorjev je bil preprosto vpisan NOP NOP, namesto vektor nekam v ram, kjer bi lahko bil return. S tem se je v tem primeru sw samo resetiral in ponovno startal OS. Če bi bilo tako kot bi moralo biti, bi se dalo narediti res zanimive debugerje tudi za Z80 ASM.

No napako sem popravil, a je takih spectrumov malo, vsega mogoče 5, ali 6, razen, če je kdo kopiral ta eeprom naprej.
Dokler bodo ljudje mislili, da živali ne čutijo bolečine, bodo živali čutile, da ljudje ne mislijowww.S5tech.net
Uporabniški avatar
VolkD
Administratorji strani
 
Prispevkov: 19047
Pridružen: 29 Dec 2014, 20:49
Kraj: Kačiče (Divača)
Zahvalil se je: 3397 krat
Prejel zahvalo: 2706 krat
Uporabnika povabil: Vrtni palček
Število neizkoriščenih povabil: 255

Re: Nostalgična koda

OdgovorNapisal/-a VolkD » 06 Maj 2017, 09:41

Ah ja. Za QL sem napisal en hecen program, ki je omogočal kopiranje "zaščitenih" mikrodrivov,...
Vsak sektor na traku microdrive je imel 1by za to, da je tam bila zapisana ena random številka ( haha random 0 do 255). To je omogočalo QL-u, da je zaznal, če si menjal kasetko medtem, ko je ni uporabljal.

Dobil sem program, mislim, da šah, ki ga je bilo treba skopirati. Ne vem kaj je problem sem vrnil kopijo, rekoč saj sploh ni zaščiten. Pa mi niso verjeli! Preprosto sem ga s copy prepisal in je delalo. !!! Ampak samo na tej kasetki. Tako sem odkril način zaščite. Debuging RAMA v QL-u je odkril način formatiranja. Generator omenjene "naključne številke" sem obšel s svojo kodo, ki je prebrala to številko z originala in nato poklical rutino za formatiranje, ter nato še rutino za kopiranje. Program v asm je bil dolg 32by in je znal kopirati večino "zaščitenih" programov.
Mislim, da je tudi ta izgubljen, čeprav sem ga dajal vsakemu, ki me je vprašal. Tako ga je dobil tudi Ciril, ter naš nekdanji minister za kulturo, pa vsi, ki so se takrat zbirali okrog radia študent, ter uredništva Moj mikro.
Dokler bodo ljudje mislili, da živali ne čutijo bolečine, bodo živali čutile, da ljudje ne mislijowww.S5tech.net
Uporabniški avatar
VolkD
Administratorji strani
 
Prispevkov: 19047
Pridružen: 29 Dec 2014, 20:49
Kraj: Kačiče (Divača)
Zahvalil se je: 3397 krat
Prejel zahvalo: 2706 krat
Uporabnika povabil: Vrtni palček
Število neizkoriščenih povabil: 255

Re: Nostalgična koda

OdgovorNapisal/-a s54mtb » 06 Maj 2017, 09:58

Pa imas kaj tvoje kode ohranjene? Meni je zanomivo, da po vec desetletjih naletis na kodo, ki si jo nekoc spisal.
s54mtb
 
Prispevkov: 6078
Pridružen: 15 Jan 2015, 01:10
Zahvalil se je: 823 krat
Prejel zahvalo: 1891 krat
Uporabnika povabil: Vrtni palček
Število neizkoriščenih povabil: 23

Re: Nostalgična koda

OdgovorNapisal/-a VolkD » 06 Maj 2017, 10:22

s54mtb je napisal/-a:Pa imas kaj tvoje kode ohranjene? Meni je zanomivo, da po vec desetletjih naletis na kodo, ki si jo nekoc spisal.
Od ZX spektruma nimam. Tudi to kar sem napisal na termični printer se je izgubilo - izbledelo.
Najstareše stvari, ki imam še ohranjene je koda v pascalu za CPM sistem - beri Partner. To kodo sem kasneje po niblih, preko printer porta prenesel na PC. Med ostalimi stvarmi mora biti še nekje po CD-jih, če so še čitljivi. Bom šel prav poiskati. Glede na to, da sem to pisal, ko sem bil zaposlen v steklarni Hrpelje, bi moralo izvirati iz let tam nekje 1984 do 1086.
Bom poskusil poiskati.
Dokler bodo ljudje mislili, da živali ne čutijo bolečine, bodo živali čutile, da ljudje ne mislijowww.S5tech.net
Uporabniški avatar
VolkD
Administratorji strani
 
Prispevkov: 19047
Pridružen: 29 Dec 2014, 20:49
Kraj: Kačiče (Divača)
Zahvalil se je: 3397 krat
Prejel zahvalo: 2706 krat
Uporabnika povabil: Vrtni palček
Število neizkoriščenih povabil: 255

Re: Nostalgična koda

OdgovorNapisal/-a VolkD » 06 Maj 2017, 10:39

Evo, takole na hitro. Tole je z leta 1992. Je program, ki je izpisal iz datoteke zalog inventurne zaloge.

Koda: Izberi vse
{$M 20000,0,140000}
PROGRAM TR13;
USES DOS,CRT,VDALLFIL,VDOFSFED,VDREORG,VDFILE,VDSORT,VDPRINT,VDCALC,VDSCR,IDXFILE,VDPARS,TMOBDDOK,VDULOOK;

CONST MDA=5;
TYPE SDT=RECORD
        DTAR:STRING[3];
        DPR:REAL;     { PROCENT DAVKA  }
        NVR:REAL;     { NAB.VRED       }
        MPV:REAL;     { MP.VRED        }
     END;

VAR CH: CHAR;
    VR:  INTEGER;
    FIRMA : STRING;
    N1,N2 : INTEGER;
    REC:BLASKL;
    MA:ART;
    DATAPATH:STRING;
    KKTO:STRING[6];
    KSKL:STRING[2];
    SVR,SMP:REAL;
    SSVR,SSMP:REAL;
    DAR:ARRAY[1..MDA] OF SDT;
    IDA:INTEGER;

PROCEDURE NOVASTRAN;
BEGIN
   PAGE;
   INC(STRAN);
   WRITELN(OUT,FIRMA,'':14,URAP,'   STRAN:',STRAN:4);
   WRITELN(OUT,TRUNCSTRL(PROGNAME),': IZPIS INVENTURNIH ZALOG PO SKLADI[^IH ');
   WRITELN(OUT);
   WRITELN(OUT,' POGOJI IZPISA:',POGIZP);
   WRITELN(OUT,' SORT PO:',SPO);
   IF INSET(KSKL,'  SKL') THEN WRITELN(OUT,' SKLADI[^E:',KSKL,' ',SI.OPIS);
   WRITELN(OUT,'IDENT         NAZIV','':33,'   ENM D.T. ',
           'KOLI^INA        NAB.CENA       MP.CENA  NAB.VREDNOST     MP.VREDNOST');
   WRITELN(OUT,CONSTSTR('_',132));
   VR:=8;
END;


PROCEDURE IZSKL;
BEGIN
   IF VR>VRT THEN NOVASTRAN;
   WRITELN(OUT,CONSTSTR('-',132));
   INC(VR);
   IF VR>VRT THEN NOVASTRAN;
   WRITELN(OUT,FORM('#####',N1),'':54,'SKUPAJ ZA SKLADI[^E ',KSKL,'':20,
               FORM('####.###.###;##',SVR),'* ',
               FORM('!##.###.###;##',SMP));
   INC(VR);
   IF VR>VRT THEN NOVASTRAN;
   SVR:=0;
   SMP:=0;
   N1:=0;
END;

PROCEDURE IZALL;
VAR I:INTEGER;
    R1,R2,R3,R4:REAL;
BEGIN
   IZSKL;
   WRITELN(OUT,CONSTSTR('-',132));
   WRITELN(OUT,FORM('#####',N),'':54,'SKUPAJ IZPIS','':30,
               FORM('####.###.###;##',SSVR),'**',
               FORM('!##.###.###;##',SSMP));
   WRITELN(OUT,CONSTSTR('-',132));
   WRITELN(OUT,'         D.TAR.   STOPNJA   NAB.VREDNOST   RAZ.V CENI(VR.)  VREDNOST DAVKA   M.P. VREDNOST');
   WRITELN(OUT,CONSTSTR('-',90));
   R1:=0;
   R2:=0;
   R3:=0;
   R4:=0;
   FOR I:=1 TO IDA DO WITH DAR[I] DO BEGIN
      WRITELN(OUT,'':12,DTAR,'   ',FORM('###;##',DPR),'%',
              FORM('!###.###.###;##',NVR),'   ',
              FORM('!###.###.###;##',MPV-NVR-MPV/(100+DPR)*DPR),' ',
              FORM('!###.###.###;##',MPV/(100+DPR)*DPR),' ',
              FORM('!###.###.###;##',MPV));
      R1:=R1+NVR;
      R2:=R2+MPV-NVR-MPV/(100+DPR)*DPR;
      R3:=R3+MPV/(100+DPR)*DPR;
      R4:=R4+MPV;
   END;
   WRITELN(OUT,CONSTSTR('-',90));
   WRITELN(OUT,'':25,FORM('!###.###.###;##',R1),'   ',
           FORM('!###.###.###;##',R2),' ',
           FORM('!###.###.###;##',R3),' ',
           FORM('!###.###.###;##',R4));
   WRITELN(OUT,CONSTSTR('-',90));
END;

{$F+}
PROCEDURE VRSTA(VAR REC:BLASKL);
VAR ID:INTEGER;
    CE:REAL;
BEGIN
   INC(N);
   INC(N1);
   INC(N2);
   WITH REC DO BEGIN
      IF KSKL<>SKL THEN BEGIN
         IF KSKL<>'' THEN IZSKL;
         KSKL:=SKL;
         NOVASTRAN;
      END;
      MA.IDENT:=IDENT;
      READIDX(FBLAG,MA);
      MA.NAZIV:=MA.NAZIV+CONSTSTR(' ',35);
      IF INVZ=0.0 THEN CE:=0
                  ELSE CE:=INVN/INVZ;
      WRITELN(OUT,IDENT,' ',COPY(MA.NAZIV,1,40),' ',MA.ENM,' ',MA.DTAR,
              FORM('#######;##',INVZ),' ',FORM('!###.###.###;##',CE),' ',
              FORM('!#.###.###;##',PRCE),' ',FORM('!#.###.###;##',INVN),' ',
              FORM('!###.###.###;##',INVV));
      SVR:=SVR+INVN;
      SSVR:=SSVR+INVN;
      SMP:=SMP+INVV;
      SSMP:=SSMP+INVV;
      ID:=1;
      WHILE (ID<=IDA) AND (MA.DTAR<>DAR[ID].DTAR) DO
                                                    INC(ID);
      IF IDA<ID THEN BEGIN
         IDA:=ID;
         DAR[ID].DTAR:=MA.DTAR;
         DA.DTAR:=MA.DTAR;
         READIDX(FDAVEK,DA);
         IF ERR<>'0' THEN BEGIN
            MSG(' NEKAJ JE NAROBE Z DAVKI'+MA.DTAR+' !!');
            WHILE NOT KEYPRESSED DO;
            TERMPROG(8);
         END;
         DAR[ID].DPR:=DA.PDAV;
      END;
      DAR[ID].NVR:=DAR[ID].NVR+INVN;
      DAR[ID].MPV:=DAR[ID].MPV+INVV;
   END;
   INC(VR);
   IF VR>VRT THEN NOVASTRAN;
END;

PROCEDURE STAVEK(VAR SA:BOOLEAN;VAR ST:STRING;VAR REC:BLASKL);
BEGIN
   WITH REC DO BEGIN
      SA:=(ODSKL=CONSTSTR(' ',2)) OR ((ODSKL<=SKL) AND (DOSKL>=SKL));
      IF NOT SA THEN EXIT;
      SA:=(ODID=CONSTSTR(' ',13)) OR ((ODID<=IDENT) AND (DOID>=IDENT));
      IF NOT SA THEN EXIT;
      IF MA.IDENT<>IDENT THEN BEGIN
         MA.IDENT:=IDENT;
         READIDX(FBLAG,MA);
      END;
      SETSRTP(MA,ST);
      ST:=SKL+ST;
      INC(NRR);
   END;
END;
{$F-}
{$I DEFSORT.PAS }

BEGIN
   DEFSORT;
   DATAPATH:=TRUNCSTR(USERLOOK('FILESDIR'));
   LENREC:=SIZEOF(REC);
   PTROUT:=@VRSTA;
   PTRINP:=@STAVEK;
   CONRPR(PS[1]);
   INC(LENSPOL,8);
   ODDOSKL;
   ODDOID;
   FIRMA:=USERLOOK('FIRNAME');
   OPENIDX(FBLAG,DATAPATH,1,SIZEOF(MA),SIZEOF(MA.IDENT),'U');
   SORTSTART(DATAPATH+FBLASKL+DAT);
   SORTINP;
   WRITELN(' DOL@INA IZHODNE DATOTEKE:',SFILESIZE(SORTWORK) DIV LENSPOL:5);
   WRITELN(' IZPIS BLAGA ');
   SELPRT(PS[2],#15);
   STRAN:=0;
   N:=0;
   N1:=0;
   N2:=0;
   KSKL:='';
   KKTO:='';
   SVR:=0;
   SSVR:=0;
   SMP:=0;
   SSMP:=0;
   OPENIDX(FDAVEK,DATAPATH,1,SIZEOF(DA),SIZEOF(DA.DTAR),'N');
   IDA:=0;
   IZPIS;
   IZALL;
   RAP;
   WRITELN;
   IF IZHOD THEN WRITELN(' IZPIS PREKINJEN');
   WRITELN(' IZPIS KON^AN');
   BEEP;
   GETKEY(CH);
   SORTEND;
   CLOSE(OUT);
   CLOSEIDX(FDAVEK);
   CLOSEIDX(FBLASKL);
   TERMPROG(0);
END.


Seveda je to le del programa, vse ostalo je po knjižnicah, v pascalu so to bili UNIT-i. Navedeni so zgoraj v tretji vrstici.
Dokler bodo ljudje mislili, da živali ne čutijo bolečine, bodo živali čutile, da ljudje ne mislijowww.S5tech.net
Uporabniški avatar
VolkD
Administratorji strani
 
Prispevkov: 19047
Pridružen: 29 Dec 2014, 20:49
Kraj: Kačiče (Divača)
Zahvalil se je: 3397 krat
Prejel zahvalo: 2706 krat
Uporabnika povabil: Vrtni palček
Število neizkoriščenih povabil: 255

Re: Nostalgična koda

OdgovorNapisal/-a VolkD » 06 Maj 2017, 10:41

Evo, še enega takega, ta je za vnos podatkov.

Koda: Izberi vse
{$M 16384,0,140000}
PROGRAM TR01;
(*****************************************************************************
 *  VZDRZEVANJE DATOTEKE BLAGA                                               *
 *****************************************************************************)
USES DOS,CRT,VDALLFIL,VDOFSFED,VDREORG,VDSORT,VDSCR,IDXFILE,TMOBDDOK,VDULOOK;

CONST AZFILE=FBLAG;
      AZSFILE='IMEART';
      AZS2FILE='CEDART';
      NSC=10;
      NSH=21;
      MTXT=11;
      TEXT0:ARRAY[1..MTXT] OF STRING=(
' Ident:               Tip :                    B.Code:              ',
' Opis :                                                             ',
' Op.S.:                                                             ',
'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ.ÄÄÄÄÄÄÄÄÄÄ',
' Enota mere :                                                       ',
' Skupina    :                                                       ',
' Dav.tarifa :                                                       ',
' Dobavitelj :                                                       ',
' Cena 1     :                                                       ',
' Cena 2     :                                                       ',
' Cena 3     :                                                       ');
TYPE WREC=ART;
     ARR=ARRAY[1..NSH*BUFFA] OF WREC;
TYPE MYEDF=OBJECT(EDFILE)
        PROCEDURE PVR(IX:INTEGER); VIRTUAL;
        FUNCTION SELREC:SHORTINT; VIRTUAL;
     END;
     PMYEDF=^MYEDF;
     MYREORG=OBJECT(REORG)
     END;
     PMYR=^MYREORG;
TYPE IDZA=RECORD
        SKL:STRING[2];
        ZAL:REAL;
     END;

LABEL KONC;

VAR NAAR:^ARR;
    NAR,NARP:WREC;
    CH:CHAR;
    DA:DAVEK;
    MS:BLASKL;
    GR:GRU;
    EDF:PMYEDF;
    REO:PMYR;
    RCAL:REAL;
    PRI:BYTE;
    NS,I:INTEGER;
    X,Y:INTEGER;
    NRCODE:REAL;
    IST:STRING;
    MPRO:STRING;
    SKL:STRING[2];
    ZSK:ARRAY[01..99] OF IDZA;
    COK:ARRAY[01..99] OF STRING[13];
    ZAX,ZAX1:BOOLEAN;

PROCEDURE WRIZA; FORWARD;
PROCEDURE WRICO; FORWARD;

PROCEDURE OUTDATA0;
VAR TA:BYTE;
    S1:STRING;
    Y:INTEGER;
    FIO:INTEGER;
BEGIN
   TA:=TEXTATTR;
   FIO:=FIDX;
   WITH NAR DO BEGIN
      GOTOXY(1,WHEREY);
      CLREOL;
      GOTOXY(1,WHEREY);
      IF AKT THEN WRITE(' ')
      ELSE BEGIN
         TEXTBACKGROUND(BROWN);
         WRITE(#247);
         CLREOL;
      END;
      IF CEN[2]<>CEN[3] THEN TEXTBACKGROUND(GREEN);
      IF SKL<>'' THEN BEGIN
         MS.IDENT:=IDENT;
         MS.SKL:=SKL;
         READIDX(FBLASKL,MS);
         IF ERR<>'0' THEN BEGIN
            MS.ZAL:=0;
         END;
      END;
      WRITE(IDENT,' ',COPY(NAZIV,1,NCO-42),' ',DTAR,' ',CODE);
      GOTOXY(1,WHEREY);
      Y:=WHEREY;
      IF ((TA AND $08)=$08) AND NOT (KEYPRESSED) THEN BEGIN
         GOTOXY(1,NS+1);
         WRITE(' N.CENA:',FORM('####.###;##',CEN[1]),
               ' R.V CENI:',FORM('####.###;##',CE2[2]),
               ' P.CENA:',FORM('####.###;##',CEN[3]),'/',
               FORM('####.###;##',CEN[2]));
{        WRITE(FORM('####.##0;00',CEN[1]),
               FORM('####.##0;00',CEN[2]),
               FORM('####.##0;00',CEN[3]),
               FORM('####.##0;00',CE2[1]),
               FORM('####.##0;00',CE2[2]),
               FORM('####.##0;00',CE2[3]));           }
         IF ZAX THEN BEGIN
            ZAX1:=FALSE;
            GOTOXY(1,Y);
            WRIZA;
         END;
         IF ZAX1 THEN BEGIN
            ZAX:=FALSE;
            GOTOXY(1,Y);
            WRICO;
         END;
      END;
      TEXTATTR:=TA;
   END;
   FIDX:=FIO;
END;

FUNCTION MYEDF.SELREC:SHORTINT;
BEGIN
   MOVE(NA,NAR,SIZEOF(NAR));
   IF EDF^.JCOMPSTR(NARP.NAZIV,NAR.NAZIV) THEN  SELREC:=0
   ELSE BEGIN
      IF NARP.NAZIV>NAR.NAZIV THEN SELREC:= 1;
      IF NARP.NAZIV<NAR.NAZIV THEN SELREC:=-1;
   END;
   EDF^.PARK:=FALSE;
END;

PROCEDURE MYEDF.PVR(IX:INTEGER);
BEGIN
   NAR:=NAAR^[IX];
   OUTDATA0;
END;
{$F+}

PROCEDURE OUTFORM1;
VAR I:INTEGER;
BEGIN
   CLRSCR;
   FOR I:=1 TO MTXT DO BEGIN
      GOTOXY(1,I);
      WRITE(TEXT0[I]);
   END;
END;

PROCEDURE OUTDATA1;
BEGIN
   WITH NAR DO BEGIN
      GOTOXY(8,1);
      WRITELN(IDENT);
      GOTOXY(29,1);
      WRITELN(TIP);
      IF INSET(TIP,'TIPST') THEN BEGIN
         GOTOXY(31,1);
         WRITE(SI.OPIS);
      END;
      GOTOXY(55,1);
      WRITE(CODE);
      GOTOXY(8,2);
      WRITELN(NAZIV);
      GOTOXY(8,3);
      WRITELN(NAZI1);
      GOTOXY(15,5);
      WRITELN(ENM);
      GOTOXY(15,6);
      GR.GRUPA:=GRUPA;
      READIDX(FGRUP,GR);
      WRITELN(GRUPA,' ',GR.OPIS);
      GOTOXY(15,7);
      WRITELN(DTAR);
      DA.DTAR:=DTAR;
      READIDX(FDAVEK,DA);
      IF ERR='0' THEN BEGIN
         GOTOXY(19,7);
         WRITE(DA.NAZD,' ',FORM('###;##',DA.PDAV),'%');
      END;
      GOTOXY(15,8);
      CLREOL;
      WRITELN(DOBAV);
      IF DOBAV<>'     ' THEN BEGIN
         KL.D.IDENT:=DOBAV;
         READIDX(KLIENTI,KL);
         GOTOXY(21,8);
         WRITE(KL.D.NASL[1]);
      END;
      GOTOXY(15,9);
      WRITELN(FORM('#####.###;##',CEN[1]),' SIT');
      GOTOXY(15,10);
      WRITELN(FORM('#####.###;##',CEN[2]),' SIT');
      GOTOXY(15,11);
      WRITELN(FORM('#####.###;##',CEN[3]),' SIT');
   END;
END;

PROCEDURE NULLDATA1;
VAR I:INTEGER;
BEGIN
   WITH NAR DO BEGIN
      ENM:='KOS';
      FOR I:=1 TO 3 DO CEN[I]:=0;
      NAZIV:='';
      NAZI1:='';
      NALEP:=0;
      AKT:=TRUE;
   END;
END;

PROCEDURE INPDATA1(VAR TC:CHAR);
CONST TERM:CHARSET = [#0,#10,#11,#13..#15,#27,#62,#107,#117,#171,#253..#255];
CONST TERM1:CHARSET = [#0,#10,#11,#13..#15,#27,#62,#107,#117,#171,#252..#255];
      MPOL=19;
VAR W,N:INTEGER;
    NAR1,NAR2:WREC;
    I:INTEGER;

PROCEDURE SETID;
BEGIN
   WITH NAR DO BEGIN
       READIDX(AZFILE,NAR);
       IF ERR<>'0' THEN BEGIN
          NAR1:=NAR;
          NAR2:=NAR;
          IF W<2 THEN NAR1.TIP:=' ';
          READIDX(AZFILE,NAR1);
          IF ERR='1' THEN BEGIN
             READIDXSUCC(AZFILE,NAR1);
             IF NAR1.IDENT<>NAR.IDENT THEN BEGIN
                READIDXPRED(AZFILE,NAR1);
                READIDXPRED(AZFILE,NAR1);
             END;
             IF NAR1.IDENT=NAR.IDENT THEN BEGIN
                NAR:=NAR1;
                IF W>1 THEN TIP:=NAR2.TIP;
                ERR:='0';
             END
             ELSE ERR:='1';
          END;
       END;
       IF ERR='0' THEN MSG(' POPRAVLJANJE !');
       IF ERR='1' THEN BEGIN
          NULLDATA1;
          MSG(' DODAJANJE !');
       END;
       OUTDATA1;
   END;
END;

FUNCTION NAJDIPROSTO:STRING;
VAR S1:STRING[5];
    NA:WREC;
BEGIN
   S1:='00001';
   ERR:='0';
   WHILE ERR='0' DO BEGIN
      INCT(S1);
      NA.IDENT:=S1+CONSTSTR(' ',8);
      READIDX(AZFILE,NA);
   END;
   NAJDIPROSTO:=S1;
END;

BEGIN
   W:=1;
   REPEAT
      IF W=MPOL+1 THEN W:=2;
      N:=W;
      IF N>10 THEN N:=10;
      WITH NAR DO CASE W OF
         1:BEGIN
            REPEAT
               MSG('F1 - Prva prosta ident ');
               INPUTSTR(IDENT,13,1,8,1,TERM1,TC);
               IDENT:=TRUNCSTRL(IDENT)+CONSTSTR(' ',13);
               IF TC=#0 THEN BEGIN
                  IDENT:=NAJDIPROSTO;
                  NULLDATA1;
                  OUTFORM1;
                  OUTDATA1;
               END;
               IDENT:=COPY(IDENT,1,5)+CONSTSTR(' ',8);
               IDENT:=TRUNCSTRL(IDENT)+CONSTSTR(' ',13);
            UNTIL NOT((IDENT=CONSTSTR(' ',13)) AND NOT (TC IN [#27,#14,#15]));
            SETID;
         END;
         2:BEGIN
            TABCHR('TIPST',INPUTCHAR,TIP,29,1,TERM,TC);
            IF INSET(TIP,'TIPST') THEN BEGIN
               GOTOXY(31,1);
               WRITE(SI.OPIS);
            END;
            SETID;
         END;
         6:BEGIN
            INPUTSTR(CODE,13,2,55,1,TERM,TC);
            CODE:=CODE+CONSTSTR(' ',13);
         END;
         7:REPEAT
            INPUTSTR(NAZIV,50,2,8,2,TERM,TC);
            NAZIV:=NAZIV+CONSTSTR(' ',50);
         UNTIL NAZIV[1]<>' ';
         8:BEGIN
            INPUTSTR(NAZI1,50,2,8,3,TERM,TC);
            NAZI1:=NAZI1+CONSTSTR(' ',50);
         END;
         9:BEGIN
            TABSTR('ENMER',INPUTSTRLA,ENM,3,0,15,5,TERM1,TC);
            ENM:=ENM+'   ';
         END;
        11:REPEAT
            INPUTSTR(GRUPA,2,1,15,6,TERM,TC);
            GRUPA:=GRUPA+'  ';
            CASE TC OF
               #0:SELDOK('TR02.EXE',GRUPA);
               #27:EXIT;
            END;
            GR.GRUPA:=GRUPA;
            READIDX(FGRUP,GR);
            IF ERR<>'0' THEN BEGIN
               REPLY('GRUPE NI V DATOTEKI - DODAJANJE (D/N/ESC)',['D','N',#27],TC);
               CASE TC OF
                  #27:EXIT;
                  'D':SELDOK('TR02.EXE',GRUPA);
               END;
            END;
            GR.GRUPA:=GRUPA;
            READIDX(FGRUP,GR);
            IF ERR='0' THEN BEGIN
               GOTOXY(15,6);
               WRITE(GRUPA,' ',GR.OPIS);
            END;
         UNTIL ERR='0';
        12:REPEAT
            INPUTSTRRA(DTAR,3,2,15,7,TERM,TC);
            CASE TC OF
               #0:BEGIN
                  SELDOK('AD11.EXE',DTAR);
               END;
               #27:EXIT;
            END;
            DA.DTAR:=DTAR;
            READIDX(FDAVEK,DA);
            IF ERR<>'0' THEN BEGIN
               REPLY('KLJU^A DAVKA NI V DATOTEKI - DODAJANJE (D/N/ESC)',['D','N',#27],TC);
               CASE TC OF
                  #27:EXIT;
                  'D':SELDOK('AD11.EXE',DTAR);
               END;
            END;
            DA.DTAR:=DTAR;
            READIDX(FDAVEK,DA);
            IF ERR='0' THEN BEGIN
               GOTOXY(19,7);
               WRITE(DA.NAZD,' ',FORM('###;##',DA.PDAV),'%');
            END;
         UNTIL ERR='0';
        13: REPEAT
            INPUTSTRRA(DOBAV,5,0,15,8,TERM,TC);
            CASE TC OF
               #0:BEGIN
                  SELDOK('AD09.EXE',DOBAV);
               END;
               #27:EXIT;
            END;
            ERR:='0';
            KL.D.NASL[1]:=CONSTSTR(' ',40);
            IF DOBAV<>'     ' THEN BEGIN
               KL.D.IDENT:=DOBAV;
               READIDX(KLIENTI,KL);
               IF ERR<>'0' THEN BEGIN
                  REPLY('POSLOVNEGA PARTNERJA NI V DATOTEKI - DODAJANJE (D/N/ESC)',['D','N',#27],TC);
                  CASE TC OF
                     #27:EXIT;
                     'D':SELDOK('AD09.EXE',DOBAV);
                  END;
               END;
            END;
            IF ERR='0' THEN BEGIN
               GOTOXY(21,8);
               WRITE(KL.D.NASL[1]);
            END;
         UNTIL ERR='0';
        14:IF TIP IN ['M','U'] THEN BEGIN
           INPUTREAL(CEN[1],12,2,15,9,TERM,TC);
        END;
        16:IF TIP IN ['M','U'] THEN BEGIN
           INPUTREAL(CEN[2],12,2,15,10,TERM,TC);
        END;
        18:IF TIP IN ['M','U'] THEN BEGIN
           INPUTREAL(CEN[3],12,2,15,11,TERM,TC);
        END;
      END;
      IF (TC=#117) AND CTRL THEN BEGIN
         TC:=#13;
         W:=MPOL;
      END;
      IF (TC=#$FF) AND (W=MPOL) THEN TC:=#13;
      IF TC=#171 THEN W:=1;
      IF (TC=#13) OR (TC=#10) OR (TC=#$FF) THEN INC(W);
      IF TC=#11 THEN IF W<=1 THEN W:=MPOL
                             ELSE DEC(W);
   UNTIL (TC=#13) AND (W=MPOL+1) OR  (* ENTER IN ZADNJE POLJE       *)
         (TC=#14) OR                 (* PGUP                        *)
         (TC=#15) OR                 (* PGDN                        *)
         (TC=#27);                   (* ESCAPE TIPKA                *)
END;

PROCEDURE EDIT;
VAR CH:CHAR;
    ID:BYTE;
BEGIN
   DEFWINDOW(PS[5],3,3,72,19);
   SETFRAME(PS[5],'1');
   SETHEAD(PS[5],' Vzdr`evanje datoteke materiala in blaga');
   OPENWINDOW(PS[5]);
   ID:=FM^[FIDX].FIXNR;
   WITH EDF^ DO BEGIN
      IF SOSP>0 THEN NAR:=NAAR^[SOSP]
                ELSE NULLDATA1;
      IF FKEY<>'' THEN NAR.IDENT:=FKEY;
   END;
   IF PARAMSTR(1)<>'' THEN NULLDATA1;
   OUTFORM1;
   OUTDATA1;
   CH:=#1;
   WHILE NOT (CH IN [#13,#27])DO BEGIN
      INPDATA1(CH);
      CASE CH OF
         #13:BEGIN
            CO.CODE:=NAR.CODE;
            CO.IDENT:=NAR.IDENT;
            CO.AKT:=TRUE;
            WRITEIDX(FCODE,CO);
            WRITEIDX(AZFILE,NAR);
            GOTOXY(1,NS+1);
            WRITE(' PODATKI SO V DATOTEKI');
            CLREOL;
            IF ID=1 THEN READIDX(AZFILE,NAR)
                    ELSE READIDXSEC(AZSFILE,NAR);
         END;
         #14:READIDXPRED(AZFILE,NAR);
         #15:READIDXSUCC(AZFILE,NAR);
      END;
   END;
   UNLOCKIDX(AZFILE);
   PS[5]:=CLOSEWINDOW;
   FREEWINDOW(PS[5]);
   SETWINDOW(PS[1]);
   SETWINDOW(PS[3]);
END;

PROCEDURE FIND;
VAR TA:BYTE;
BEGIN
   TA:=TEXTATTR;
   IF FM^[FIDX].FIXNR=1 THEN BEGIN
      NAR.IDENT:=FKEY;
      NAR.IDENT:=NAR.IDENT+CONSTSTR(' ',13);
      GOTOXY(2,NS);
      TEXTATTR:=$6A;
      WRITE(FKEY);
      TEXTATTR:=TA;
      WRITE(' ');
      CLREOL;
      IF CH IN [#13,#255] THEN READIDX(AZFILE,NAR);
   END
   ELSE IF FM^[FIDX].FIXNR=2 THEN BEGIN
      NAR.NAZIV:=FKEY;
      NAR.NAZIV:=NAR.NAZIV+CONSTSTR(' ',50);
      GOTOXY(16,NS);
      TEXTATTR:=$6A;
      WRITE(FKEY);
      TEXTATTR:=TA;
      WRITE(' ');
      CLREOL;
      IF CH IN [#13,#255] THEN BEGIN
         READIDXSEC(AZSFILE,NAR);
         IF ERR<>'0' THEN BEGIN
            READIDXPRED(AZSFILE,NAR);
            READIDXSUCC(AZSFILE,NAR);
         END;
      END;
   END
   ELSE IF FM^[FIDX].FIXNR=3 THEN BEGIN
      NAR.CODE:=FKEY+CONSTSTR(' ',13);
      GOTOXY(59,NS);
      TEXTATTR:=$6A;
      WRITE(FKEY);
      TEXTATTR:=TA;
      WRITE(' ');
      CLREOL;
      IF CH IN [#13,#255] THEN BEGIN
         READIDXSEC(AZS2FILE,NAR);
         IF ERR<>'0' THEN BEGIN
            READIDXPRED(AZS2FILE,NAR);
            READIDXSUCC(AZS2FILE,NAR);
         END;
      END;
   END;
END;

PROCEDURE CLEARFIND;
BEGIN
   GOTOXY(1,NS);
   CLREOL;
END;

PROCEDURE SETSECKEY;
VAR TB:BYTE;
BEGIN
   IF FM^[FIDX].FIXNR=1 THEN BEGIN
      READIDXSEC(AZSFILE,NAR);
      EDF^.FNA:=AZSFILE;
      EDF^.PARK:=TRUE;
      GOTOXY(16,NS);
      TB:=TEXTATTR;
      TEXTBACKGROUND(GREEN);
      WRITE(CONSTSTR(' ',48));
      TEXTATTR:=TB;
   END
   ELSE IF FM^[FIDX].FIXNR=2 THEN BEGIN
      READIDXSEC(AZS2FILE,NAR);
      EDF^.FNA:=AZS2FILE;
      EDF^.PARK:=TRUE;
      GOTOXY(65,NS);
      TB:=TEXTATTR;
      TEXTBACKGROUND(GREEN);
      WRITE(CONSTSTR(' ',13));
      TEXTATTR:=TB;
   END
   ELSE IF FM^[FIDX].FIXNR=3 THEN BEGIN
      READIDX(AZFILE,NAR);
      EDF^.FNA:=AZFILE;
      GOTOXY(2,NS);
      TB:=TEXTATTR;
      TEXTBACKGROUND(GREEN);
      WRITE(CONSTSTR(' ',13));
      TEXTATTR:=TB;
   END;
   IF ERR<>'0' THEN MSG(' STAVKA NI V DATOTEKI');
END;

PROCEDURE DELETE;
VAR ID:BYTE;
BEGIN
   ID:=FM^[FIDX].FIXNR;
   WITH EDF^ DO BEGIN
      IF SOSP<1 THEN EXIT;
      NAR:=NAAR^[SOSP];
   END;
   DELETEIDX(AZFILE,NAR);
   IF ID=1 THEN READIDX(AZFILE,NAR)
           ELSE READIDXSEC(AZSFILE,NAR);
END;

PROCEDURE NOSHDEL; FORWARD;

PROCEDURE SHDEL;
BEGIN
   WITH EDF^ DO BEGIN
      IF SOSP<1 THEN EXIT;
      NAR:=NAAR^[SOSP];
      SETDEL(TRUE);
      ADDPROC(#62,TRUE,NOSHDEL,'Prika`i samo akt.');
   END;
   IF FM^[FIDX].FIXNR=1 THEN READIDX(AZFILE,NAR)
                        ELSE READIDXSEC(AZSFILE,NAR);
END;

PROCEDURE NOSHDEL;
BEGIN
   WITH EDF^ DO BEGIN
      IF SOSP<1 THEN EXIT;
      NAR:=NAAR^[SOSP];
      SETDEL(FALSE);
      ADDPROC(#62,TRUE,SHDEL,'Prika`i brisane  ');
   END;
   IF FM^[FIDX].FIXNR=1 THEN READIDX(AZFILE,NAR)
                        ELSE READIDXSEC(AZSFILE,NAR);
END;

PROCEDURE LIN(VAR IX:INTEGER);
BEGIN
   IF IX=1 THEN BEGIN
      WRITE(' Dav.tarife in klasif.');
      EXIT;
   END;
   IF INSET(FORM('#',IX-1),'  CEN') THEN
      WRITE(' ',COPY(SI.OPIS+CONSTSTR(' ',20),1,20));
END;

PROCEDURE OUTFORM;
CONST MGL=2;
      GL:ARRAY[1..2] OF STRING=(
' IDENT         OPIS                                   DAV B.CODE    ',
'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ');
VAR I:INTEGER;
    ST17:STRING[17];
    SS:STRING;
BEGIN
   SETHEAD(PS[1],' Datoteka blaga ');
   OPENWINDOW(PS[1]);
   CLRSCR;
   FOR I:=1 TO MGL DO BEGIN
      GOTOXY(1,I);
      WRITE(GL[I])
   END;
   IF SKL<>'' THEN BEGIN
      GOTOXY(55,1);
      WRITE('ZALOGA NA SKLADI[^U:',SKL);
   END;
END;

PROCEDURE TRANSFER;
VAR SMA44:STRING;
BEGIN
   WITH NAAR^[EDF^.SOSP] DO BEGIN
      SMA44:=IDENT;
      EXPDOK(MPRO,SMA44);
   END;
END;

PROCEDURE STAT;
BEGIN
   REO:=NEW(PMYR,INIT);
   REO^.STATISTIC(AZFILE);
   DISPOSE(REO,KONEC);
END;

PROCEDURE KRSTA1(VAR REC:WREC);
VAR S:ARRAY[1..MRLEN] OF CHAR ABSOLUTE REC;
    ST1:STRING;
    I:INTEGER;
BEGIN
   WITH REC DO BEGIN
      IF TRUNCSTR(NAZIV)='' THEN EXIT;
      WHILE (NAZIV[1]=' ') AND (LENGTH(NAZIV)>1) DO NAZIV:=COPY(NAZIV,2,50)+' ';
      CEN[2]:=CEN[3];
   END;
   BLOCKWRITE(FOU,REC,1);
END;

PROCEDURE REORG1;
BEGIN
   REO:=NEW(PMYR,INIT);
   PTROUT:=@KRSTA1;
   REO^.REORGF(AZFILE);
   DISPOSE(REO,KONEC);
END;

PROCEDURE KRSTA(VAR REC:WREC);
VAR S:ARRAY[1..MRLEN] OF CHAR ABSOLUTE REC;
    ST1:STRING;
    I:INTEGER;
BEGIN
   WITH REC DO BEGIN
      IF TRUNCSTR(NAZIV)='' THEN EXIT;
      WHILE (NAZIV[1]=' ') AND (LENGTH(NAZIV)>1) DO NAZIV:=COPY(NAZIV,2,50)+' ';
      IF DTAR='070' THEN DTAR:='D08';
      IF DTAR='071' THEN DTAR:='D19';
   END;
   BLOCKWRITE(FOU,REC,1);
END;

PROCEDURE REORG;
BEGIN
   REO:=NEW(PMYR,INIT);
   PTROUT:=@KRSTA;
   REO^.REORGF(AZFILE);
   DISPOSE(REO,KONEC);
END;

PROCEDURE SETNS;
BEGIN
   IF NLN=25 THEN NS:=NSC
             ELSE NS:=NSH;
   GOTOXY(1,1);
   DEFWINDOWR(PS[1],PS[3],1,7,NCO-2,NS+4,2);
END;

PROCEDURE WRIZAL;
BEGIN
   NAR:=NAAR^[EDF^.SOSP];
   ZAX:=NOT ZAX;
   IF FM^[FIDX].FIXNR=1 THEN READIDX(AZFILE,NAR)
                        ELSE READIDXSEC(AZSFILE,NAR);
END;

PROCEDURE WRICOD;
BEGIN
   NAR:=NAAR^[EDF^.SOSP];
   ZAX1:=NOT ZAX1;
   IF FM^[FIDX].FIXNR=1 THEN READIDX(AZFILE,NAR)
                        ELSE READIDXSEC(AZSFILE,NAR);
END;

PROCEDURE PIVR(VAR IX:INTEGER);
BEGIN
   WRITE(ZSK[IX].SKL,' ',FORM('###.###.###;##',ZSK[IX].ZAL),' ',NAR.ENM);
END;

PROCEDURE PIVRO(VAR IX:INTEGER);
BEGIN
   WRITE(COK[IX]);
END;

PROCEDURE WRIZA;
VAR ISK:INTEGER;
    NRV:INTEGER;
    OSO,OSP:INTEGER;
    OVR:POINTER;
    II:INTEGER;

FUNCTION DEFW:INTEGER;
VAR Y,DY:INTEGER;
BEGIN
   Y:=WHEREY+3;
   DY:=ISK+2;
   IF Y+DY>NLN THEN BEGIN
      IF DY>NLN-Y THEN BEGIN
         DY:=NLN-Y;
         Y:=1;
      END
      ELSE Y:=NLN-DY;
   END;
   DEFWINDOW(PS[7],50,Y,74,Y+DY);
   DEFW:=DY-2;
END;

BEGIN
   II:=FIDX;
   ISK:=0;
   IF EDF^.SOSP>0 THEN BEGIN
      NAR:=NAAR^[EDF^.SOSP];
      WITH NAR DO BEGIN
         MS.IDENT:=IDENT;
         MS.SKL:='  ';
         READIDX(FBLASKL,MS);
         READIDXPRED(FBLASKL,MS);
         READIDXSUCC(FBLASKL,MS);
         WHILE (MS.IDENT=IDENT) AND
               (ERR='0') DO BEGIN
            IF (MS.IDENT=IDENT) THEN BEGIN
               INC(ISK);
               ZSK[ISK].SKL:=MS.SKL;
               ZSK[ISK].ZAL:=MS.ZAL;
            END;
            READIDXSUCC(FBLASKL,MS);
         END;
         IF ISK>0 THEN BEGIN
            NRV:=DEFW;
            SETFRAME(PS[7],'1');
            OPENWINDOW(PS[7]);
            CLRSCR;
            OVR:=PTRLINE;
            PTRLINE:=@PIVR;
            OSO:=SO;
            OSP:=SP;
            SO:=0;
            SP:=0;
            FSEDITR:=TRUE;
            CH:=#0;
            FSEDIT(ISK,NRV,SO,SP,CH);
            WHILE NOT KEYPRESSED DO;
            PS[7]:=CLOSEWINDOW;
            FREEWINDOW(PS[7]);
            KILLWINDOW(PS[7]);
         END
         ELSE BEGIN
            ISK:=1;
            NRV:=DEFW;
            SETFRAME(PS[7],'1');
            OPENWINDOW(PS[7]);
            CLRSCR;
            WRITE(' Ni prometa  !');
            WHILE NOT KEYPRESSED DO;
            PS[7]:=CLOSEWINDOW;
            FREEWINDOW(PS[7]);
            KILLWINDOW(PS[7]);
         END;
      END;
   END;
   FIDX:=II;
   IF FM^[FIDX].FIXNR=1 THEN READIDX(AZFILE,NAR)
                        ELSE READIDXSEC(AZSFILE,NAR);
END;

PROCEDURE WRICO;
VAR ISK:INTEGER;
    NRV:INTEGER;
    OSO,OSP:INTEGER;
    OVR:POINTER;
    II:INTEGER;

FUNCTION DEFW:INTEGER;
VAR Y,DY:INTEGER;
BEGIN
   Y:=WHEREY+3;
   DY:=ISK+2;
   IF Y+DY>NLN THEN BEGIN
      IF DY>NLN-Y THEN BEGIN
         DY:=NLN-Y;
         Y:=1;
      END
      ELSE Y:=NLN-DY;
   END;
   DEFWINDOW(PS[7],50,Y,74,Y+DY);
   DEFW:=DY-2;
END;

BEGIN
   II:=FIDX;
   ISK:=0;
   IF EDF^.SOSP>0 THEN BEGIN
      NAR:=NAAR^[EDF^.SOSP];
      WITH NAR DO BEGIN
         CO.IDENT:=IDENT;
         READIDXSEC('IDCODE',CO);
         READIDXPRED(FCODE,CO);
         READIDXSUCC(FCODE,CO);
         WHILE (CO.IDENT=IDENT) AND
               (ERR='0') DO BEGIN
            IF (CO.IDENT=IDENT) THEN BEGIN
               INC(ISK);
               COK[ISK]:=CO.CODE;
            END;
            READIDXSUCC(FCODE,CO);
         END;
         IF ISK>0 THEN BEGIN
            NRV:=DEFW;
            SETFRAME(PS[7],'1');
            OPENWINDOW(PS[7]);
            CLRSCR;
            OVR:=PTRLINE;
            PTRLINE:=@PIVRO;
            OSO:=SO;
            OSP:=SP;
            SO:=0;
            SP:=0;
            FSEDITR:=TRUE;
            CH:=#0;
            FSEDIT(ISK,NRV,SO,SP,CH);
            WHILE NOT KEYPRESSED DO;
            PS[7]:=CLOSEWINDOW;
            FREEWINDOW(PS[7]);
            KILLWINDOW(PS[7]);
         END
         ELSE BEGIN
            ISK:=1;
            NRV:=DEFW;
            SETFRAME(PS[7],'1');
            OPENWINDOW(PS[7]);
            CLRSCR;
            WRITE(' Ni code  !');
            WHILE NOT KEYPRESSED DO;
            PS[7]:=CLOSEWINDOW;
            FREEWINDOW(PS[7]);
            KILLWINDOW(PS[7]);
         END;
      END;
   END;
   FIDX:=II;
   IF FM^[FIDX].FIXNR=1 THEN READIDX(AZFILE,NAR)
                        ELSE READIDXSEC(AZSFILE,NAR);
END;
{$F-}
BEGIN
   NARP.NAZIV:='';
   WITH NAR DO BEGIN
      ENM:='';
      GRUPA:='';
      DTAR:='';
      DOBAV:='';
      NAZIV:='';
   END;
   SKL:='';
   ZAX:=FALSE;
   ZAX1:=FALSE;
   MPRO:=PARAMSTR(1);
   OPENIDX(KLIENTI,DATAPATH,1,SIZEOF(KL),SIZEOF(KL.D.IDENT),'N');
   SAVEIDX(KLIENTI);
   OPENIDX(FGRUP,DATAPATH,1,SIZEOF(GR),SIZEOF(GR.GRUPA),'N');
   SAVEIDX(FGRUP);
   OPENIDX(FCODE,DATAPATH,1,SIZEOF(CO),SIZEOF(CO.CODE),'N');
   OPENSECIDX(FCODE,'IDCODE',15,14,'U');
   OPENIDX(FDAVEK,DATAPATH,1,SIZEOF(DA),SIZEOF(DA.DTAR),'N');
   SAVEIDX(FDAVEK);
   OPENIDX(FBLASKL,DATAPATH,1,SIZEOF(MS),SIZEOF(MS.IDENT)+SIZEOF(MS.SKL),'U');
   SAVEIDX(FBLASKL);
   OPENIDX(AZFILE,DATAPATH,1,SIZEOF(NAR),
           SIZEOF(NAR.IDENT),'U');
   OPENSECIDX(AZFILE,AZSFILE,16,51,'U');
   OPENSECIDX(AZFILE,AZS2FILE,153,14,'U');
   SAVEIDX(AZFILE);
   GOTOXY(61,11);
   SETNS;
   SETFRAME(PS[1],'1');
   PRI:=1;
   OPENWINDOW(PS[3]);
   CLRSCR;
   EDF:=NEW(PMYEDF,INIT(' ZA^ETEK DATOTEKE',' KONEC DATOTEKE',' V DATOTEKI NI PODATKOV'));
   WITH EDF^ DO BEGIN
      OUTFORM;
      SETWINDOW(PS[1]);
      SETWINDOW(PS[3]);
      SETFS(AZFILE,NS-1,NAAR);
      IF PARAMCOUNT>0 THEN WITH NAR DO BEGIN
         GETDOK(MPRO,IST);
         CASE IST[1] OF
            '+':BEGIN
                CH:=#255;
                IST:=COPY(IST,2,50);
                FKEY:=TRUNCSTR(IST);
                NAR.NAZIV:=FKEY+CONSTSTR(' ',50);
                READIDXSEC(AZSFILE,NAR);
                FIND;
                SETFS(AZSFILE,NS-1,NAAR);
             END;
             '*':BEGIN
                IST:=COPY(IST,2,50);
                IDENT:=COPY(IST,1,13);
                FKEY:=IDENT;
                FIND;
                READIDX(AZFILE,NAR);
                SETFS(AZFILE,NS-1,NAAR);
             END;
             '/':BEGIN
                CODE:=COPY(IST,2,13);
                FKEY:=CODE;
                READIDXSEC(AZS2FILE,NAR);
                FIND;
                READIDX(AZFILE,NAR);
                SETFS(AZFILE,NS-1,NAAR);
                IF IST[15]='R' THEN BEGIN
                   TRANSFER;
                   GOTO KONC;
                END;
             END;
             ELSE BEGIN
                IDENT:=COPY(IST,1,13);
                FKEY:=IDENT;
                FIND;
                READIDX(AZFILE,NAR);
                SETFS(AZFILE,NS-1,NAAR);
             END;
         END;
      END;
      ADDPROC(#60,TRUE,EDIT,'Popravljanje,dodajanje');
      ADDPROC(#13,FALSE,EDIT,'Popravljanje,dodajanje');
      ADDPROC(#$FF,FALSE,FIND,'Iskanje');
      ADDPROC(#$FE,TRUE,FIND,'Bri{i iskalno polje');
      ADDPROC(#62,TRUE,SHDEL,'Prika`i brisane');
      ADDPROC(#63,TRUE,SETSECKEY,'Po Ident, Nazivu, Bcodi');
      ADDPROC(#64,TRUE,WRICOD,'Pregled code');
      ADDPROC(#65,TRUE,WRIZAL,'Pregled zaloge');
      ADDPROC(#105,TRUE,DELETE,'Brisanje');
      ADDPROC(#108,TRUE,STAT,'Statistika datoteke');
      ADDPROC(#109,TRUE,REORG,'Reorganizacija datoteke');
      ADDPROC(#110,TRUE,REORG1,'BRISANJE OZNAKE NOVE CENE');
      IF PARAMSTR(1)<>'' THEN BEGIN
         ADDPROC(#68,TRUE,TRANSFER,'Prenos podatkov');
         ADDPROC(#13,FALSE,TRANSFER,'Prenos podatkov');
      END;
      CH:=#0;
      MOVEFILEPOS([#27,#117,#79],CH);
   END;
KONC:
   DISPOSE(EDF,KONEC);
   CLOSEIDX(AZFILE);
   CLOSEIDX(FBLASKL);
   CLOSEIDX(FDAVEK);
   CLOSEIDX(KLIENTI);
   CLOSEIDX(FCODE);
   CLOSEIDX(FGRUP);
   TERMPROG(0);
END.


Vem da tole ne izgleda ravno kot pascal - no večino vam nepoznanih stvari je dejansko v mojih knjižnicah, ki jih pa sedaj nikakor ne morem najti. So seveda starejše od tega programa...
Dokler bodo ljudje mislili, da živali ne čutijo bolečine, bodo živali čutile, da ljudje ne mislijowww.S5tech.net
Uporabniški avatar
VolkD
Administratorji strani
 
Prispevkov: 19047
Pridružen: 29 Dec 2014, 20:49
Kraj: Kačiče (Divača)
Zahvalil se je: 3397 krat
Prejel zahvalo: 2706 krat
Uporabnika povabil: Vrtni palček
Število neizkoriščenih povabil: 255

Re: Nostalgična koda

OdgovorNapisal/-a VolkD » 06 Maj 2017, 10:48

Pa še eden, ta je kasnejšega datuma. 7.2.2001 piše, uporablja pa te iste knjižnice. Program je obračunoval dohodnino in je bil sestavni del programskega paketa plač. Takrat se je temu reklo osebni dohodek.
Koda: Izberi vse
{$M 20000,0,140000}
PROGRAM DO04;
{ IZPIS POVZETKA OBRACUNA                                                 *
*  V3.070 - ZACETNA VERZIJA PROGRAMA PREVEDENA Z BP 7.0                   *
*  V3.071 - DODAN 53                                                      *
*                                                                         }
USES DOS,CRT,VDSCR,VDSORT,VDFSEDT,VDFILE,VDPRINT,IDXFILE,VDPARS,PLUNT,VDULOOK;
{$I FDOH.PAS}
{$I FMATDEL.PAS}

VAR CH: CHAR;
    VR:  INTEGER;
    FIRMA,DATAPATH,APLIK : STRING;
    LETO:INTEGER;
    REC : DOH;
    RR,RE,RP,RA,RN,RB,RU,RD,RG,RC:DOH;
    SR,SE,SP,SA,SN,SB,SU,SF,SG,SC:DOH;
    NR:INTEGER;

FUNCTION ZADOH(VAR R:REAL):REAL;
VAR RR:REAL;
BEGIN
   RR:=R/10;
   ZAOKR(RR);
   ZADOH:=RR*10;
END;

FUNCTION OPI(OP:STRING):STRING;
BEGIN
   IF OP='10' THEN OPI:='10 Pla~a,nad.';
   IF OP='11' THEN OPI:='11 Bonitete  ';
   IF OP='12' THEN OPI:='12 Regres    ';
   IF OP='13' THEN OPI:='13 Drugi pr. ';
   IF OP='15' THEN OPI:='15 Ost.nadom.';
   IF OP='16' THEN OPI:='16 Dr.prejem.';
   IF OP='19' THEN OPI:='19 Pril.st.  ';
   IF OP='51' THEN OPI:='51 Udel.dobi~';
   IF OP='55' THEN OPI:='55 Doh.najem.';
   IF OP='61' THEN OPI:='61 Avtorstva ';
END;

PROCEDURE NOVASTRAN1;
CONST NA:ARRAY[1..3] OF STRING=(
'Zap. EM[O          Priimek in ime       [if. Vrsta                       '+
'                    Akontacija     Prisp.za soc. Samoprisp.',
'[t.                                     dav. dohodka              Znesek '+
' Normirani          dohodnine       varn.in pos.             ',
'                                        izp. ozn opis                    '+
'   stro{ki         v RS   v tujini  pris.po zak.             ');
BEGIN
   WRITELN(OUT,CONSTSTR('_',132));
   WRITELN(OUT);
   WRITELN(OUT,NA[1]);
   WRITELN(OUT,NA[2]);
   WRITELN(OUT,NA[3]);
   WRITELN(OUT,CONSTSTR('_',132));
   INC(VR,5);
END;

PROCEDURE NOVASTRAN0;
VAR DD,MM,LL,WE:WORD;
BEGIN
   PAGE;
   INC(STRAN);
   GETDATE(LL,MM,DD,WE);
   WRITELN(OUT,'':90,DD:2,'.',MM:2,'.',LL:4);
   WRITELN(OUT,'@IRO RA^UN:',USERLOOK('ZRAC'),'':10,USERLOOK('FIRNAZ'));
   WRITELN(OUT,'':35,'NASLOV IZPLA^EVALCA:',USERLOOK('FIRNAS'));
   WRITELN(OUT);
   WRITELN(OUT,' Povzetek obra~una dohodkov izpla~anih v obdobju od  1. 1.',
               ' do 31.12. leta ',FORM('@@@@',LETO));
   VR:=6;
   NOVASTRAN1;
END;

PROCEDURE NOVASTRAN;
BEGIN
   PAGE;
   INC(STRAN);
   VR:=1;
   NOVASTRAN1;
END;

PROCEDURE SUMMD;
BEGIN
   WITH RR DO IF ZNE<>0 THEN BEGIN
      INC(NR);
      WRITELN(OUT,FORM('@@@@',NR),' ',EMSO,' ',PRIM,' ',OBCI,' ',OPI('10'),' ',
              FORM('#####.###.###',ZNE),' ',FORM('#.###.###',STR),' ',
              FORM('#####.###.###',ADO),'           ',FORM('#####.###.###',PRI),' ',
              FORM('###.###.###',SAM));
      INC(VR);
      IF VR>VRT THEN NOVASTRAN;
   END;
   WITH RB DO IF ZNE<>0 THEN BEGIN
      INC(NR);
      WRITELN(OUT,FORM('@@@@',NR),' ',EMSO,' ',PRIM,' ',OBCI,' ',OPI('11'),' ',
              FORM('#####.###.###',ZNE),' ',FORM('#.###.###',STR),' ',
              FORM('#####.###.###',ADO),'           ',FORM('#####.###.###',PRI),' ',
              FORM('###.###.###',SAM));
      INC(VR);
      IF VR>VRT THEN NOVASTRAN;
   END;
   WITH RE DO IF ZNE<>0 THEN BEGIN
      INC(NR);
      WRITELN(OUT,FORM('@@@@',NR),' ',EMSO,' ',PRIM,' ',OBCI,' ',OPI('12'),' ',
              FORM('#####.###.###',ZNE),' ',FORM('#.###.###',STR),' ',
              FORM('#####.###.###',ADO),'           ',FORM('#####.###.###',PRI),' ',
              FORM('###.###.###',SAM));
      INC(VR);
      IF VR>VRT THEN NOVASTRAN;
   END;
   WITH RD DO IF ZNE<>0 THEN BEGIN
      INC(NR);
      WRITELN(OUT,FORM('@@@@',NR),' ',EMSO,' ',PRIM,' ',OBCI,' ',OPI('13'),' ',
              FORM('#####.###.###',ZNE),' ',FORM('#.###.###',STR),' ',
              FORM('#####.###.###',ADO),'           ',FORM('#####.###.###',PRI),' ',
              FORM('###.###.###',SAM));
      INC(VR);
      IF VR>VRT THEN NOVASTRAN;
   END;
   WITH RN DO IF ZNE<>0 THEN BEGIN
      INC(NR);
      WRITELN(OUT,FORM('@@@@',NR),' ',EMSO,' ',PRIM,' ',OBCI,' ',OPI('15'),' ',
              FORM('#####.###.###',ZNE),' ',FORM('#.###.###',STR),' ',
              FORM('#####.###.###',ADO),'           ',FORM('#####.###.###',PRI),' ',
              FORM('###.###.###',SAM));
      INC(VR);
      IF VR>VRT THEN NOVASTRAN;
   END;
   WITH RC DO IF ZNE<>0 THEN BEGIN
      INC(NR);
      WRITELN(OUT,FORM('@@@@',NR),' ',EMSO,' ',PRIM,' ',OBCI,' ',OPI('16'),' ',
              FORM('#####.###.###',ZNE),' ',FORM('#.###.###',STR),' ',
              FORM('#####.###.###',ADO),'           ',FORM('#####.###.###',PRI),' ',
              FORM('###.###.###',SAM));
      INC(VR);
      IF VR>VRT THEN NOVASTRAN;
   END;
   WITH RP DO IF ZNE<>0 THEN BEGIN
      INC(NR);
      WRITELN(OUT,FORM('@@@@',NR),' ',EMSO,' ',PRIM,' ',OBCI,' ',OPI('19'),' ',
              FORM('#####.###.###',ZNE),' ',FORM('#.###.###',STR),' ',
              FORM('#####.###.###',ADO),'           ',FORM('#####.###.###',PRI),' ',
              FORM('###.###.###',SAM));
      INC(VR);
      IF VR>VRT THEN NOVASTRAN;
   END;
   WITH RU DO IF ZNE<>0 THEN BEGIN
      INC(NR);
      WRITELN(OUT,FORM('@@@@',NR),' ',EMSO,' ',PRIM,' ',OBCI,' ',OPI('51'),' ',
              FORM('#####.###.###',ZNE),' ',FORM('#.###.###',STR),' ',
              FORM('#####.###.###',ADO),'           ',FORM('#####.###.###',PRI),' ',
              FORM('###.###.###',SAM));
      INC(VR);
      IF VR>VRT THEN NOVASTRAN;
   END;
   WITH RG DO IF ZNE<>0 THEN BEGIN
      INC(NR);
      WRITELN(OUT,FORM('@@@@',NR),' ',EMSO,' ',PRIM,' ',OBCI,' ',OPI('55'),' ',
              FORM('#####.###.###',ZNE),' ',FORM('#.###.###',STR),' ',
              FORM('#####.###.###',ADO),'           ',FORM('#####.###.###',PRI),' ',
              FORM('###.###.###',SAM));
      INC(VR);
      IF VR>VRT THEN NOVASTRAN;
   END;
   WITH RA DO IF ZNE<>0 THEN BEGIN
      INC(NR);
      WRITELN(OUT,FORM('@@@@',NR),' ',EMSO,' ',PRIM,' ',OBCI,' ',OPI('61'),' ',
              FORM('#####.###.###',ZNE),' ',FORM('#.###.###',STR),' ',
              FORM('#####.###.###',ADO),'           ',FORM('#####.###.###',PRI),' ',
              FORM('###.###.###',SAM));
      INC(VR);
      IF VR>VRT THEN NOVASTRAN;
   END;
END;

PROCEDURE SUMFI;
BEGIN
   WITH SR DO IF ZNE<>0 THEN BEGIN
      INC(NR);
      WRITELN(OUT,FORM('@@@@',NR),' XXXXXXXXXXXXX SKUPAJ','':15,'XXXX ',OPI('10'),' ',
              FORM('#####.###.###',ZNE),' ',FORM('#.###.###',STR),' ',
              FORM('#####.###.###',ADO),'           ',FORM('#####.###.###',PRI),' ',
              FORM('###.###.###',SAM));
      INC(VR);
      IF VR>VRT THEN NOVASTRAN;
   END;
   WITH SB DO IF ZNE<>0 THEN BEGIN
      INC(NR);
      WRITELN(OUT,FORM('@@@@',NR),' XXXXXXXXXXXXX SKUPAJ','':15,'XXXX ',OPI('11'),' ',
              FORM('#####.###.###',ZNE),' ',FORM('#.###.###',STR),' ',
              FORM('#####.###.###',ADO),'           ',FORM('#####.###.###',PRI),' ',
              FORM('###.###.###',SAM));
      INC(VR);
      IF VR>VRT THEN NOVASTRAN;
   END;
   WITH SE DO IF ZNE<>0 THEN BEGIN
      INC(NR);
      WRITELN(OUT,FORM('@@@@',NR),' XXXXXXXXXXXXX SKUPAJ','':15,'XXXX ',OPI('12'),' ',
              FORM('#####.###.###',ZNE),' ',FORM('#.###.###',STR),' ',
              FORM('#####.###.###',ADO),'           ',FORM('#####.###.###',PRI),' ',
              FORM('###.###.###',SAM));
      INC(VR);
      IF VR>VRT THEN NOVASTRAN;
   END;
   WITH SF DO IF ZNE<>0 THEN BEGIN
      INC(NR);
      WRITELN(OUT,FORM('@@@@',NR),' XXXXXXXXXXXXX SKUPAJ','':15,'XXXX ',OPI('13'),' ',
              FORM('#####.###.###',ZNE),' ',FORM('#.###.###',STR),' ',
              FORM('#####.###.###',ADO),'           ',FORM('#####.###.###',PRI),' ',
              FORM('###.###.###',SAM));
      INC(VR);
      IF VR>VRT THEN NOVASTRAN;
   END;
   WITH SN DO IF ZNE<>0 THEN BEGIN
      INC(NR);
      WRITELN(OUT,FORM('@@@@',NR),' XXXXXXXXXXXXX SKUPAJ','':15,'XXXX ',OPI('15'),' ',
              FORM('#####.###.###',ZNE),' ',FORM('#.###.###',STR),' ',
              FORM('#####.###.###',ADO),'           ',FORM('#####.###.###',PRI),' ',
              FORM('###.###.###',SAM));
      INC(VR);
      IF VR>VRT THEN NOVASTRAN;
   END;
   WITH SC DO IF ZNE<>0 THEN BEGIN
      INC(NR);
      WRITELN(OUT,FORM('@@@@',NR),' XXXXXXXXXXXXX SKUPAJ','':15,'XXXX ',OPI('16'),' ',
              FORM('#####.###.###',ZNE),' ',FORM('#.###.###',STR),' ',
              FORM('#####.###.###',ADO),'           ',FORM('#####.###.###',PRI),' ',
              FORM('###.###.###',SAM));
      INC(VR);
      IF VR>VRT THEN NOVASTRAN;
   END;
   WITH SP DO IF ZNE<>0 THEN BEGIN
      INC(NR);
      WRITELN(OUT,FORM('@@@@',NR),' XXXXXXXXXXXXX SKUPAJ','':15,'XXXX ',OPI('19'),' ',
              FORM('#####.###.###',ZNE),' ',FORM('#.###.###',STR),' ',
              FORM('#####.###.###',ADO),'           ',FORM('#####.###.###',PRI),' ',
              FORM('###.###.###',SAM));
      INC(VR);
      IF VR>VRT THEN NOVASTRAN;
   END;
   WITH SU DO IF ZNE<>0 THEN BEGIN
      INC(NR);
      WRITELN(OUT,FORM('@@@@',NR),' XXXXXXXXXXXXX SKUPAJ','':15,'XXXX ',OPI('51'),' ',
              FORM('#####.###.###',ZNE),' ',FORM('#.###.###',STR),' ',
              FORM('#####.###.###',ADO),'           ',FORM('#####.###.###',PRI),' ',
              FORM('###.###.###',SAM));
      INC(VR);
      IF VR>VRT THEN NOVASTRAN;
   END;
   WITH SG DO IF ZNE<>0 THEN BEGIN
      INC(NR);
      WRITELN(OUT,FORM('@@@@',NR),' XXXXXXXXXXXXX SKUPAJ','':15,'XXXX ',OPI('55'),' ',
              FORM('#####.###.###',ZNE),' ',FORM('#.###.###',STR),' ',
              FORM('#####.###.###',ADO),'           ',FORM('#####.###.###',PRI),' ',
              FORM('###.###.###',SAM));
      INC(VR);
      IF VR>VRT THEN NOVASTRAN;
   END;
   WITH SA DO IF ZNE<>0 THEN BEGIN
      INC(NR);
      WRITELN(OUT,FORM('@@@@',NR),' XXXXXXXXXXXXX SKUPAJ','':15,'XX ',OPI('61'),' ',
              FORM('#####.###.###',ZNE),' ',FORM('#.###.###',STR),' ',
              FORM('#####.###.###',ADO),'           ',FORM('#####.###.###',PRI),' ',
              FORM('###.###.###',SAM));
      INC(VR);
      IF VR>VRT THEN NOVASTRAN;
   END;
END;

{$F+}
PROCEDURE VRSTA(REC:DOH);
BEGIN
   INC(N);
   WITH REC DO BEGIN
      REC.ZNE:=ZADOH(REC.ZNE);
      REC.STR:=ZADOH(REC.STR);
      REC.ADO:=ZADOH(REC.ADO);
      REC.PRI:=ZADOH(REC.PRI);
      REC.SAM:=ZADOH(REC.SAM);
      IF MD.OSST<>SD THEN BEGIN
         IF MD.OSST<>'' THEN SUMMD;
         MD.OSST:=SD;
         READIDX(FMATDEL,MD);
         IF ERR<>'0' THEN EXIT;
         RR:=REC;
         RP:=REC;
         RE:=REC;
         RA:=REC;
         RN:=REC;
         RB:=REC;
         RU:=REC;
         RD:=REC;
         RG:=REC;
         RC:=REC;
         RR.ZNE:=0;
         RR.STR:=0;
         RR.ADO:=0;
         RR.PRI:=0;
         RR.SAM:=0;
         RG.ZNE:=0;
         RG.STR:=0;
         RG.ADO:=0;
         RG.PRI:=0;
         RG.SAM:=0;
         RD.ZNE:=0;
         RD.STR:=0;
         RD.ADO:=0;
         RD.PRI:=0;
         RD.SAM:=0;
         RE.ZNE:=0;
         RE.STR:=0;
         RE.ADO:=0;
         RE.PRI:=0;
         RE.SAM:=0;
         RP.ZNE:=0;
         RP.STR:=0;
         RP.ADO:=0;
         RP.PRI:=0;
         RP.SAM:=0;
         RA.ZNE:=0;
         RA.STR:=0;
         RA.ADO:=0;
         RA.PRI:=0;
         RA.SAM:=0;
         RN.ZNE:=0;
         RN.STR:=0;
         RN.ADO:=0;
         RN.PRI:=0;
         RN.SAM:=0;
         RB.ZNE:=0;
         RB.STR:=0;
         RB.ADO:=0;
         RB.PRI:=0;
         RB.SAM:=0;
         RU.ZNE:=0;
         RU.STR:=0;
         RU.ADO:=0;
         RU.PRI:=0;
         RU.SAM:=0;
         RC.ZNE:=0;
         RC.STR:=0;
         RC.ADO:=0;
         RC.PRI:=0;
         RC.SAM:=0;
      END;
      IF VPR='10' THEN BEGIN
         RR.ZNE:=RR.ZNE+REC.ZNE;
         RR.STR:=RR.STR+REC.STR;
         RR.ADO:=RR.ADO+REC.ADO;
         RR.PRI:=RR.PRI+REC.PRI;
         RR.SAM:=RR.SAM+REC.SAM;
         SR.ZNE:=SR.ZNE+REC.ZNE;
         SR.STR:=SR.STR+REC.STR;
         SR.ADO:=SR.ADO+REC.ADO;
         SR.PRI:=SR.PRI+REC.PRI;
         SR.SAM:=SR.SAM+REC.SAM;
      END;
      IF VPR='11' THEN BEGIN
         RB.ZNE:=RB.ZNE+REC.ZNE;
         RB.STR:=RB.STR+REC.STR;
         RB.ADO:=RB.ADO+REC.ADO;
         RB.PRI:=RB.PRI+REC.PRI;
         RB.SAM:=RB.SAM+REC.SAM;
         SB.ZNE:=SB.ZNE+REC.ZNE;
         SB.STR:=SB.STR+REC.STR;
         SB.ADO:=SB.ADO+REC.ADO;
         SB.PRI:=SB.PRI+REC.PRI;
         SB.SAM:=SB.SAM+REC.SAM;
      END;
      IF VPR='12' THEN BEGIN
         RE.ZNE:=RE.ZNE+REC.ZNE;
         RE.STR:=RE.STR+REC.STR;
         RE.ADO:=RE.ADO+REC.ADO;
         RE.PRI:=RE.PRI+REC.PRI;
         RE.SAM:=RE.SAM+REC.SAM;
         SE.ZNE:=SE.ZNE+REC.ZNE;
         SE.STR:=SE.STR+REC.STR;
         SE.ADO:=SE.ADO+REC.ADO;
         SE.PRI:=SE.PRI+REC.PRI;
         SE.SAM:=SE.SAM+REC.SAM;
      END;
      IF VPR='13' THEN BEGIN
         RD.ZNE:=RD.ZNE+REC.ZNE;
         RD.STR:=RD.STR+REC.STR;
         RD.ADO:=RD.ADO+REC.ADO;
         RD.PRI:=RD.PRI+REC.PRI;
         RD.SAM:=RD.SAM+REC.SAM;
         SF.ZNE:=SF.ZNE+REC.ZNE;
         SF.STR:=SF.STR+REC.STR;
         SF.ADO:=SF.ADO+REC.ADO;
         SF.PRI:=SF.PRI+REC.PRI;
         SF.SAM:=SF.SAM+REC.SAM;
      END;
      IF VPR='15' THEN BEGIN
         RN.ZNE:=RN.ZNE+REC.ZNE;
         RN.STR:=RN.STR+REC.STR;
         RN.ADO:=RN.ADO+REC.ADO;
         RN.PRI:=RN.PRI+REC.PRI;
         RN.SAM:=RN.SAM+REC.SAM;
         SN.ZNE:=SN.ZNE+REC.ZNE;
         SN.STR:=SN.STR+REC.STR;
         SN.ADO:=SN.ADO+REC.ADO;
         SN.PRI:=SN.PRI+REC.PRI;
         SN.SAM:=SN.SAM+REC.SAM;
      END;
      IF VPR='16' THEN BEGIN
         RC.ZNE:=RC.ZNE+REC.ZNE;
         RC.STR:=RC.STR+REC.STR;
         RC.ADO:=RC.ADO+REC.ADO;
         RC.PRI:=RC.PRI+REC.PRI;
         RC.SAM:=RC.SAM+REC.SAM;
         SC.ZNE:=SC.ZNE+REC.ZNE;
         SC.STR:=SC.STR+REC.STR;
         SC.ADO:=SC.ADO+REC.ADO;
         SC.PRI:=SC.PRI+REC.PRI;
         SC.SAM:=SC.SAM+REC.SAM;
      END;
      IF VPR='19' THEN BEGIN
         RP.ZNE:=RP.ZNE+REC.ZNE;
         RP.STR:=RP.STR+REC.STR;
         RP.ADO:=RP.ADO+REC.ADO;
         RP.PRI:=RP.PRI+REC.PRI;
         RP.SAM:=RP.SAM+REC.SAM;
         SP.ZNE:=SP.ZNE+REC.ZNE;
         SP.STR:=SP.STR+REC.STR;
         SP.ADO:=SP.ADO+REC.ADO;
         SP.PRI:=SP.PRI+REC.PRI;
         SP.SAM:=SP.SAM+REC.SAM;
      END;
      IF VPR='51' THEN BEGIN
         RU.ZNE:=RU.ZNE+REC.ZNE;
         RU.STR:=RU.STR+REC.STR;
         RU.ADO:=RU.ADO+REC.ADO;
         RU.PRI:=RU.PRI+REC.PRI;
         RU.SAM:=RU.SAM+REC.SAM;
         SU.ZNE:=SU.ZNE+REC.ZNE;
         SU.STR:=SU.STR+REC.STR;
         SU.ADO:=SU.ADO+REC.ADO;
         SU.PRI:=SU.PRI+REC.PRI;
         SU.SAM:=SU.SAM+REC.SAM;
      END;
      IF VPR='55' THEN BEGIN
         RG.ZNE:=RG.ZNE+REC.ZNE;
         RG.STR:=RG.STR+REC.STR;
         RG.ADO:=RG.ADO+REC.ADO;
         RG.PRI:=RG.PRI+REC.PRI;
         RG.SAM:=RG.SAM+REC.SAM;
         SG.ZNE:=SG.ZNE+REC.ZNE;
         SG.STR:=SG.STR+REC.STR;
         SG.ADO:=SG.ADO+REC.ADO;
         SG.PRI:=SG.PRI+REC.PRI;
         SG.SAM:=SG.SAM+REC.SAM;
      END;
      IF VPR='61' THEN BEGIN
         RA.ZNE:=RA.ZNE+REC.ZNE;
         RA.STR:=RA.STR+REC.STR;
         RA.ADO:=RA.ADO+REC.ADO;
         RA.PRI:=RA.PRI+REC.PRI;
         RA.SAM:=RA.SAM+REC.SAM;
         SA.ZNE:=SA.ZNE+REC.ZNE;
         SA.STR:=SA.STR+REC.STR;
         SA.ADO:=SA.ADO+REC.ADO;
         SA.PRI:=SA.PRI+REC.PRI;
         SA.SAM:=SA.SAM+REC.SAM;
      END;
   END;
END;

PROCEDURE STAVEK(VAR SA:BOOLEAN;VAR ST:STRING;VAR REC:DOH);
BEGIN
   WITH REC DO BEGIN
      SA:=AKT;
      ST:=OBCI+SD+CHAR(LL)+CHAR(MM)+VPR;
   END;
END;
{$F-}

BEGIN
   LETO:=TRUNC(GETVALUE('LETOPL'));
   IF LETO<50 THEN LETO:=LETO+2000
              ELSE LETO:=LETO+1900;
   LENSPOL:=11;
   LENREC:=SIZEOF(REC);
   PTROUT:=@VRSTA;
   PTRINP:=@STAVEK;
   CONRPR(PS[1]);
   MSG('');
   DATAPATH:=TRUNCSTR(USERLOOK('FILESDIR'));
   OPENIDX(FMATDEL,DATAPATH,1,SIZEOF(MD),SIZEOF(MD.OSST),'N');
   FIRMA:=USERLOOK('FIRNAME');
   APLIK:=USERLOOK('APPLNAME');
   SORTSTART(DATAPATH+FDOH+'.DAT');
   SORTINP;
   WRITELN(' DOL@INA IZHODNE DATOTEKE:',SFILESIZE(SORTWORK) DIV LENSPOL:5);
   WRITELN(' IZPIS KONTROLE ZA DOHODNINO');
   SELPRT(PS[2],#15);
   MD.OSST:='';
   STRAN:=0;
   N:=0;
   SR.ZNE:=0;
   SR.STR:=0;
   SR.ADO:=0;
   SR.PRI:=0;
   SR.SAM:=0;
   SG.ZNE:=0;
   SG.STR:=0;
   SG.ADO:=0;
   SG.PRI:=0;
   SG.SAM:=0;
   SF.ZNE:=0;
   SF.STR:=0;
   SF.ADO:=0;
   SF.PRI:=0;
   SF.SAM:=0;
   SE.ZNE:=0;
   SE.STR:=0;
   SE.ADO:=0;
   SE.PRI:=0;
   SE.SAM:=0;
   SP.ZNE:=0;
   SP.STR:=0;
   SP.ADO:=0;
   SP.PRI:=0;
   SP.SAM:=0;
   SA.ZNE:=0;
   SA.STR:=0;
   SA.ADO:=0;
   SA.PRI:=0;
   SA.SAM:=0;
   SN.ZNE:=0;
   SN.STR:=0;
   SN.ADO:=0;
   SN.PRI:=0;
   SN.SAM:=0;
   SB.ZNE:=0;
   SB.STR:=0;
   SB.ADO:=0;
   SB.PRI:=0;
   SB.SAM:=0;
   SU.ZNE:=0;
   SU.STR:=0;
   SU.ADO:=0;
   SU.PRI:=0;
   SU.SAM:=0;
   SC.ZNE:=0;
   SC.STR:=0;
   SC.ADO:=0;
   SC.PRI:=0;
   SC.SAM:=0;
   NR:=0;
   OPENIDX(FSTRM,DATAPATH,1,SIZEOF(SM),SIZEOF(SM.SM),'N');
   NOVASTRAN0;
   IZPIS;
   SUMMD;
   SUMFI;
   IF PS[2]<>NIL THEN PAGE;
   SORTEND;
   CLOSE(OUT);
   CLOSEIDX(FMATDEL);
   WRITELN;
   IF IZHOD THEN WRITELN(' IZPIS PREKINJEN');
   WRITELN(' IZPIS KON^AN');
   BEEP;
   CH:=READKEY;
   PS[1]:=CLOSEWINDOW;
END.

Pascal ne loči med velikimi in malimi črkami. Stvar navade je kako pišeš. Jaz sem pisal vse z velikimi. Tudi če si kupil kakšne knjižnice, so običajno prišle z velikimi črkami.
Dokler bodo ljudje mislili, da živali ne čutijo bolečine, bodo živali čutile, da ljudje ne mislijowww.S5tech.net
Uporabniški avatar
VolkD
Administratorji strani
 
Prispevkov: 19047
Pridružen: 29 Dec 2014, 20:49
Kraj: Kačiče (Divača)
Zahvalil se je: 3397 krat
Prejel zahvalo: 2706 krat
Uporabnika povabil: Vrtni palček
Število neizkoriščenih povabil: 255

Re: Nostalgična koda

OdgovorNapisal/-a VolkD » 06 Maj 2017, 10:53

Mogoče je tole najstarejši program, ki ga še imam. Datira na leto 1989, točneje 5.11.1989.Torej je to čas DOS-a. Program na ekran izriše okenčka v katerih se lahko z puščicami giblješ gor ali dol, z enter pa izbereš. V tem primeru program požene deug program, ki izvaja to kar si izbral. Neke vrste meni.
Koda: Izberi vse
{$M 24000,0,120000}
PROGRAM MENU;
{ MENU PROGRAM                                                            *
*  V3.031 - ZACETNA VERZIJA                                               *
*  V3.020 - POENOTEN VERZIJA Z OZNAKO PODMENUJA                           *
*  V3.051 - ZAPRTA DATOTEKA ULOOK MED DELOM                               *
*  V3.100 - PROGRAM DELUJE NA 50X90 EKRANU                                *
*         - PREDVIDEN JE TUDI ZA IZDAJO DEMO VERZIJE                      *
*         - PROGRAME KI SO SE POGNALI OZNACI Z                           *
*         - NE OBRISE OZADJA AMPAK PUSTI DA PROGRAM MENUINT OPRAVI SVOJE  *
*  V4.100 - NOVE KNJIZNICE                                                *
*                                                                         }
USES CRT,DOS,VDALLFIL,VDULOOK,VDSCR,VDFILE,IDXFILE,GKUNT;
CONST COPYRIGHT:STRING[159]=(
       #24+#25+'-IZBIRA            ENTER - IZVAJANJE           '+
       '     ESC-PREHOD NA VI[JI MENU                          '+
       '                                          PRITISNI ALT !');

VAR SCR:SFILE;
    PPOP:INTEGER;
    ST:STRING;
    PW:POINTER;
    S,P:MENUREC;
    TA:ARRAY[1..16] OF MENUREC;
    TS:ARRAY[1..16] OF INTEGER;
    MI:ARRAY[1..5] OF INTEGER;  (* MENU IZBIRA *)
    MS:ARRAY[1..5] OF INTEGER;  (* MENU START  *)
    N,I,J,ITC:INTEGER;
    POZ:INTEGER;
    MTA:INTEGER;
    EC:CHAR;
    IFI,A:STRING[39];
    IF1,SNAME:STRING;
    S1,S2:STRING;
    DATAPATH:STRING;
    OP:BOOLEAN;

PROCEDURE COPYF(INAME,ONAME:STRING);
CONST MAXR=8192;
VAR INF,OUF:FILE;
    BUFF:ARRAY[1..MAXR] OF BYTE;
    RR,RC:WORD;
    IOR:INTEGER;
BEGIN
   ASSIGN(INF,INAME);
   RESET(INF,1);
   ASSIGN(OUF,ONAME);
   REWRITE(OUF,1);
   RR:=MAXR;
   RC:=RR;
   WHILE RR=RC DO BEGIN
      BLOCKREAD(INF,BUFF,RR,RC);
      IOR:=IORESULT;
      BLOCKWRITE(OUF,BUFF,RC);
   END;
   CLOSE(INF);
   CLOSE(OUF);
END;

PROCEDURE INTSCR;
VAR FP:LONGINT;
    SCRS:FILE OF MENUREC;
    NAME,NAMEX,MENUDATX,PATH,S3:STRING;
    F1,F2:FILE;
    L1,L2:LONGINT;
    CO:BOOLEAN;
BEGIN
   FSPLIT(MENUDAT,PATH,NAME,S3);
   MENUDATX:=PATH+NAME+'.IDX';
   DEC(BYTE(NAME[0]),2);              { SKRAJSAJ IME ZA 2 ZNAKA  }
   NAMEX:=PATH+NAME+'.IDX';
   NAME:=PATH+NAME+S3;
   CO:=FALSE;
   IF NOT SEXIST(MENUDAT) THEN CO:=TRUE;
   IF NOT SEXIST(NAME) THEN CO:=TRUE;
   IF NOT CO THEN BEGIN
      ASSIGN(F1,MENUDAT);
      RESET(F1);
      GETFTIME(F1,L1);
      ASSIGN(F2,NAME);
      RESET(F2);
      GETFTIME(F2,L2);
      IF L1<>L2 THEN CO:=TRUE;
      CLOSE(F1);
      CLOSE(F2);
   END;
   IF CO THEN BEGIN
      MSG(' FILE '+MENUDAT+' IS TIME SET ! NAME='+NAME+' NAMEX='+NAMEX);
      ASSIGN(F1,NAME);
      RESET(F1);
      GETFTIME(F1,L1);
      ASSIGN(F1,NAMEX);
      RESET(F1);
      GETFTIME(F1,L2);
      COPYF(NAME,MENUDAT);
      COPYF(NAMEX,MENUDATX);
      ASSIGN(F1,MENUDAT);
      RESET(F1);
      SETFTIME(F1,L1);
      CLOSE(F1);
      ASSIGN(F1,MENUDATX);
      RESET(F1);
      SETFTIME(F1,L2);
      CLOSE(F1);
   END;
   IFI:=TRUNCSTR(USERLOOK('MENUDAT'));        { MAKE INDEX STATION ULOOK }
   IF IFI='' THEN IFI:='MENU.DAT';
   SASSIGN(SCR,IFI);
   SRESET(SCR,TRUE);
   SBLOCKREAD(SCR,P,SIZEOF(MENUREC));
   SCLOSE(SCR);
END;

PROCEDURE GETPOP(I:INTEGER;VAR P:MENUREC);
BEGIN
   SRESET(SCR,TRUE);
   SLONGSEEK(SCR,I*SIZEOF(MENUREC));
   SBLOCKREAD(SCR,P,SIZEOF(MENUREC));
   SCLOSE(SCR);
END;

PROCEDURE SETIF1;
BEGIN
   I:=POS('@',IF1);
   WHILE I<>0 DO BEGIN
      J:=POS(' ',COPY(IF1,I,80));
      IF I>0 THEN IF1:=COPY(IF1,1,I-1)+
                       TRUNCSTR(USERLOOK(COPY(IF1,I+1,J-1)))+
                       COPY(IF1,I+J,80);
      I:=POS('@',IF1);
   END;
END;

PROCEDURE OUTFORM0;
BEGIN
   DEFWINDOW(PS[9],1,1,NCO,1);
   OPENWINDOW(PS[9]);
   CLRSCR;
   WRITE('  ',COPY(USERLOOK('FIRNAME'),1,36)+USERLOOK('APPLNAME'));
   SAVEW(SCRPTR(PS[9])^.PTSCB);
   PS[9]:=CLOSEWINDOW;
   KILLWINDOW(PS[9]);
END;

PROCEDURE OUTFORM;
VAR FIN:TEXT;
    STRI:STRING;
BEGIN
   DEFWINDOW(PS[1],1,1,NCO,NLN);
   OPENWINDOW(PS[1]);
   IF EXIST('MENUINIT.SCR') THEN BEGIN
      ASSIGN(FIN,'MENUINIT.SCR');
      RESET(FIN);
      WHILE NOT EOF(FIN) DO BEGIN
         READLN(FIN,STRI);
         WRITELN(STRI);
      END;
      CLOSE(FIN);
   END;
   OUTFORM0;
   GOTOXY(1,2);
   WRITE(CONSTSTR(#196,NCO));
   GOTOXY(1,NLN-2);
   WRITE(CONSTSTR(#196,NCO));
END;

PROCEDURE PIVR(VAR TA:MENUREC);
BEGIN
   CASE TA.TXT[39] OF
      #254:TEXTCOLOR(BLUE);
      #4:BEGIN
         TEXTCOLOR(LIGHTCYAN);
         TA.TXT[39]:=#254;
      END;
      ELSE TEXTCOLOR(BLACK);
   END;
   IF TA.KL[1]='*' THEN BEGIN
      TEXTCOLOR(BROWN);
      IF POS(#2,TA.TXT)=0 THEN TA.TXT:=COPY(#2+' '+TRUNCSTRL(TA.TXT),2,40);
   END;
   IF POS('.EXE',TA.PR)=0 THEN WRITE(#16,TRUNCSTRL(COPY(TA.TXT,2,40)))
                          ELSE WRITE(' ',TRUNCSTRL(TA.TXT));
END;

PROCEDURE WRMENU;
BEGIN
   FOR I:=1 TO MTA DO BEGIN
      GOTOXY(1,I);
      PIVR(TA[I]);
   END;
END;

PROCEDURE WRTMEN(PO:INTEGER;P:MENUREC);
VAR R:MENUREC;
    GL:STRING[41];
    I:INTEGER;
    DX:INTEGER;
BEGIN
   PPOP:=PO;
   IF PO>1 THEN BEGIN
      GETPOP(PPOP-1,R);
      GL:=R.TXT;
   END
   ELSE GL:='';
   WHILE COPY(GL,LENGTH(GL)-1,2)='  ' DO GL:=COPY(GL,1,LENGTH(GL)-1);
   GETPOP(PPOP,R);
   N:=0;
   WHILE COPY(R.TXT,N+1,1)=' ' DO INC(N);
   IF N>4 THEN N:=4;
   IF N<1 THEN N:=1;
   MTA:=0;
   PPOP:=PO;
   WHILE COPY(R.TXT,N,1)=' ' DO BEGIN
      GETPOP(PPOP,R);
      INC(PPOP);
      IF (COPY(R.TXT,N+1,1)<>' ') AND
         (COPY(R.TXT,N,1)=' ') THEN BEGIN
         IF (TOG.VSM>=R.KL[1]) OR
            NOT (R.KL[1] IN ['0'..'9']) OR
            (TOG.VSM='1') THEN BEGIN
            INC(MTA);
            IF (TOG.VSM='1') AND  (R.KL[1]>'1') THEN R.KL[1]:='*';
            TA[MTA]:=R;
            TS[MTA]:=PPOP-1;
            IF R.TXT=P.TXT THEN POZ:=MTA;
         END;
      END;
   END;
   DX:=0;
   IF (N*4)*(NLN DIV 20)+MTA+1>NLN-2 THEN DX:=(N*4)*(NLN DIV 20)+MTA+3-NLN;
   IF PS[N+1]=NIL THEN DEFWINDOW(PS[N+1],(N-1)*11+4,(N*4)*(NLN DIV 20)-DX,(N-1)*11+45,(N*4)*(NLN DIV 20)+MTA+1-DX);
   SETFRAME(PS[N+1],'1');
   SETHEAD(PS[N+1],GL);
   OPENWINDOW(PS[N+1]);
   CLRSCR;
   WRMENU;
END;

PROCEDURE INPDATA(MPOL:INTEGER;VAR W:INTEGER;VAR TC:CHAR);
CONST TERM:CHARSET = [#10,#11,#27,#18,#13,#104,#253..#255];
VAR S:STRING;
    TB:BYTE;
BEGIN
   REPEAT
      IF W=MPOL+1 THEN W:=1;
      S:=TRUNCSTR(TA[W].EX);
      IF TRUNCSTR(TA[W].KL)<>'' THEN S:='';
      IF (S<>'') THEN MSG(S)
                 ELSE MSG(COPYRIGHT);
      IF TA[W].KL[1]='*' THEN PRMSG(' PROGRAM V TEJ VERZIJI APLIKACIJE NI DOSEGLJIV !');
      IF POS('.EXE',TA[W].PR)=0 THEN A:=#16+TRUNCSTRL(COPY(TA[W].TXT,2,40))+' '
                                ELSE A:=' '+TRUNCSTRL(TA[W].TXT)+CONSTSTR(' ',40);
      GOTOXY(1,W);
      CLREOL;
      TB:=TEXTATTR;
      TEXTATTR:=INVERSE(TEXTATTR);
      INPUTSTR(A,39,5,1,W,TERM,TC);
      IF (TC=#104) AND CTRL THEN PISTXT(COPY(TA[W].PR,1,POS('.',TA[W].PR)-1)+'.HLP');
      TEXTATTR:=TB;
      GOTOXY(1,W);
      IF TC<>#13 THEN CLREOL;
      PIVR(TA[W]);
      GOTOXY(1,W);
      IF (TC=#13) AND (TA[W].KL[1]='*') THEN TC:=#1;
      IF TC=#10 THEN INC(W);
      IF TC=#11 THEN IF W=1 THEN W:=MPOL
                            ELSE DEC(W);
   UNTIL TC IN [#27,#13];
END;

PROCEDURE RENEWMEN;
BEGIN
   DEC(PPOP);
   GETPOP(PPOP,P);
   WHILE COPY(P.TXT,N+1,1)=' ' DO BEGIN
      GETPOP(PPOP,P);
      DEC(PPOP,1);
   END;
   INC(PPOP);
   S:=P;
   IF N=1 THEN PPOP:=1
   ELSE BEGIN
      WHILE COPY(S.TXT,N,1)=' ' DO BEGIN
         DEC(PPOP);
         GETPOP(PPOP,S);
      END;
      INC(PPOP);
   END;
END;

PROCEDURE SETMENUES;
BEGIN
   GETPOP(1,P);
   MS[1]:=1;
   PPOP:=2;
   WRTMEN(MS[1],P);
END;

FUNCTION PASS(S:STRING):BOOLEAN;
VAR N:WORD;
    S78:STRING[78];
BEGIN
   IF (S[1] IN ['D','T']) THEN BEGIN
      S78:=COPY(S,2,12);
      IF NOT EXIST(S78) THEN IF S[1]='D' THEN S78:='MENU.DMO';
      IF NOT EXIST(S78) THEN IF S[1]='T' THEN S78:='MENU.TST';
      PISTXT(S78);
   END;
   PASS:=TRUE;
   N:=POS('PASS=',S);
   IF N=0 THEN EXIT;
   SWAPVECTORS;
   EXEC(FEXPAND(FSEARCH('MENUPASS.EXE',GETENV('PATH'))),S);
   PASS:=DOSEXITCODE=0;
   SWAPVECTORS;
END;

BEGIN
   SETVIDEOM;
   CURON;
   INTSCR;
   REINTULOOK;
   INTVDSCR;
   VK1:=NIC;
   SETBORDER($07);
   DATAPATH:=TRUNCSTR(USERLOOK('FILESDIR'));
   OP:=FALSE;
   IF SEXIST(DATAPATH+VRVKNJ+DAT) THEN OP:=TRUE;
   IF OP THEN BEGIN
      OPENIDX(VRVKNJ,DATAPATH,1,SIZEOF(TOP),SIZEOF(TOP.TIP)+SIZEOF(TOP.VK)+SIZEOF(TOP.ST),'N');
      SAVEIDX(VRVKNJ);
   END
   ELSE TOG.VSM:='9';
   DEFWINDOW(PS[7],1,1,NCO,NLN);
   OPENWINDOW(PS[7]);
   CLRSCR;
   SWAPVECTORS;
{$IFNDEF DPMI }
   SETMEMTOP(HEAPPTR);
{$ENDIF}
   EXEC(FEXPAND(FSEARCH('MENUAEXE.EXE',GETENV('PATH'))),'A');
{$IFNDEF DPMI }
   SETMEMTOP(HEAPEND);
{$ENDIF}
   ITC:=DOSEXITCODE;
   IF OP THEN SETOPPAS;
   SWAPVECTORS;
   IF ITC<>0 THEN BEGIN
      MSG(' NEKAJ [E NI CISTO OK ! PREVERI PATH NA PODATKE !  ERR:'+FORM('@@@',ITC));
      BEEP;
      SDELAY(4000);
      SETBORDER($00);
      TERMPROG(ITC);
   END;
   OUTFORM;
   ALTMSG:=' F1 - OPIS PROGRAMA ';
   IFI:=TRUNCSTR(USERLOOK('MENUDAT'));
   IF IFI='' THEN IFI:='MENU.DAT';
   SASSIGN(SCR,IFI);
   POZ:=1;
   MSG(COPYRIGHT);
   SETMENUES;
   INC(PPOP);
   REPEAT
      INPDATA(MTA,POZ,EC);
      PPOP:=TS[POZ]+1;
      CASE EC OF
         #13:BEGIN
            IF PASS(TA[POZ].KL)  THEN BEGIN
               GETPOP(PPOP,P);
               TA[POZ].TXT[39]:=#4;
               WRMENU;
               IF COPY(P.TXT,N+1,1)=' ' THEN BEGIN
                  POZ:=1;
                  WRTMEN(PPOP,P);
               END
               ELSE WITH TA[POZ] DO BEGIN
                  IF COPY(PR,1,4)='    ' THEN TERMPROG(0);
                  IF1:='';
                  IF TRUNCSTR(COPY(KL,2,20))<>'' THEN IF1:=KL+EX;
                  SETIF1;
                  ST:=' '+COPY(IF1,2,80);
                  IF TRUNCSTR(PR)='*DOS' THEN BEGIN
                     ST:='/C'+ST;
{$IFNDEF DPMI }
                     SETMEMTOP(HEAPPTR);
{$ENDIF}
                     EXEC(GETENV('COMSPEC'),TRUNCSTR(ST));
{$IFNDEF DPMI }
                     SETMEMTOP(HEAPEND);
{$ENDIF}
                     VAL(COPY(IF1,1,1),ITC,I);
                     TERMPROG(ITC);
                  END;
                  S1:=TRUNCSTR(COPY(' '+TRUNCSTR(TRUNCSTRL(TA[POZ].TXT)),1,30));
                  S2:=TRUNCSTR(COPY(A,1,30));
                  IF S1<>S2 THEN ST:=A;
                  GOTOXY(1,POZ);
                  SWAPVECTORS;
{$IFNDEF DPMI }
                  SETMEMTOP(HEAPPTR);
{$ENDIF}
                  EXEC(TRUNCSTR(FEXPAND(FSEARCH(PR,GETENV('PATH')))),TRUNCSTR(ST));
{$IFNDEF DPMI }
                  SETMEMTOP(HEAPEND);
{$ENDIF}
                  ITC:=DOSEXITCODE;
                  SWAPVECTORS;
                  IF (NLN<>BPTR(PTR($40,$84))^+1) OR
                     (NCO<>BPTR(PTR($40,$4A))^) THEN TERMPROG(27);
                  IF ITC<>0 THEN BEGIN
                     SETBORDER($00);
                     MSG(' PREPISI SI NAPAKO - IN JAVI ! PROGRAM:'+PR);
                     BEEP;
                     GETKEY(EC);
                     TERMPROG(ITC);
                  END;
                  IF OP THEN SETOPPAS;
                  REINTULOOK;
                  PS[N+1]:=CLOSEWINDOW;
                  FREEWINDOW(PS[N+1]);
                  KILLWINDOW(PS[N+1]);
                  RENEWMEN;
                  EC:=#1;
                  WRTMEN(PPOP,P);
                  TA[POZ].TXT[39]:=#254;
                  WRMENU;
                  TA[POZ].TXT[39]:=#4;
                  OUTFORM0;
               END;
            END;
         END;
         #27:BEGIN
            PS[N+1]:=CLOSEWINDOW;
            FREEWINDOW(PS[N+1]);
            KILLWINDOW(PS[N+1]);
            DEC(N);
            IF N=0 THEN BEGIN
               SWAPVECTORS;
               EXEC(FEXPAND(FSEARCH('MENUAEXE.EXE',GETENV('PATH'))),'E');
               SWAPVECTORS;
               SETBORDER($00);
               TERMPROG(0);
            END;
            PS[N+1]:=CLOSEWINDOW;
            FREEWINDOW(PS[N+1]);
            KILLWINDOW(PS[N+1]);
            RENEWMEN;
            EC:=#1;
            WRTMEN(PPOP,P);
            TA[POZ].TXT[39]:=#254;
            WRMENU;
         END;
      END;
   UNTIL EC=#27;
END.

Pri vsem tem vodi še evidenco kdaj je bil kateri o programov pognan, in kdaj je končal z delom. Neke vrste log torej.

V zvezi s tem logom je tudi ena dobra anekdota:
Pred tem moram nekaj moram povedati. Da bi vsaj malo zaščitil podatke, so bili programi, ki so čakali na vnos, narejeni tako, da so po 10 minutah čakanja, zaprli vse datoteke in kontrolo vrnili v ta program menuja.

V neki firmi, kjer se itak ni vedelo kdo pije in kdo plača, so se delavke v računovodstvu sklicevale, da so preobremenjene in da ne zmorejo vsega,..... bla ble bla... Med ostalim so navedle tudi, da je knjiženje zamudno in da čepijo cele dneve za računalnikom, kar škoduje njihovim očem,.....

Pa me njihova šefica, istočasno tudi financ minister, previdno pobara: A bi se dalo kako narediti, da bi bilo vnašanje bolj tekoče ?
Jaz pa samo O_0 ? Kje se pa zatika ?

No potem je prišla pa bolj konkretno na dan: Ja punce pravijo, da gre počasi in da so cele dneve za računalnikom.
Jaz pa Hmmmmm ... skoraj ne verjamem, da imajo res toliko dela. Pa sem ženski pred očmi izpisal koliko časa so in kateri programi so bili kdaj - po urah aktivni za vsak dan peteklega meseca posebej, pa za vsako dekle, ker so itak imele vsaka svojo prijavo.
No potem je bilo pa teh in takih zgodbic hitro konec.

Pa tega nisem programiral zaradi takih stvari, temveč zato, ker so programi seveda imeli bug-e. Ampak ko je kateri od programov prekinil svoje delo, je seveda izpisal neko kodo s pomočjo katere sem retrogradno lahko ugotovil točno v kateri vrstici je spustil dušo. Ker v nekaj letih nisem uspel vzgojiti uporabnikov, da je to kodo treba zapisati, sem v svoje knjižnice vdelal ta logging in vanj zapisoval tudi te kode napak. Na ta način sem kasneje s pomočjo teh logov iskal recimo napake, kot so zero devide,.... da bi se jim kasneje izognil. Tako so nastajale novejše verzije programov, ki funkcionalno niso bile nič drugačne, so pa bili programi bolj robustni.
Dokler bodo ljudje mislili, da živali ne čutijo bolečine, bodo živali čutile, da ljudje ne mislijowww.S5tech.net
Uporabniški avatar
VolkD
Administratorji strani
 
Prispevkov: 19047
Pridružen: 29 Dec 2014, 20:49
Kraj: Kačiče (Divača)
Zahvalil se je: 3397 krat
Prejel zahvalo: 2706 krat
Uporabnika povabil: Vrtni palček
Število neizkoriščenih povabil: 255

Re: Nostalgična koda

OdgovorNapisal/-a gumby » 06 Maj 2017, 16:24

VolkD je napisal/-a:Vse kar sem uspel naložiti s teh kaset je bil en star precej slab šah. Ostalo je bilo neberljivo. Z gotovostjo torej lahko trdim, da je source izgubljen.

Podatke iz kaset bi se verjetno dalo dobit nazaj... cviljenje spraviš na PC in spustiš kak program čez, ki "prebere" podatke.
Na C64 se spomim, da je bil problem že, če je bila glava kasetofona malo postrani nastavljena.
my brain hurts
Uporabniški avatar
gumby
 
Prispevkov: 1751
Pridružen: 14 Jan 2015, 19:49
Kraj: Lendava
Zahvalil se je: 79 krat
Prejel zahvalo: 381 krat
Uporabnika povabil: Vrtni palček
Število neizkoriščenih povabil: 48

Re: Nostalgična koda

OdgovorNapisal/-a VolkD » 06 Maj 2017, 17:39

gumby je napisal/-a:Na C64 se spomim, da je bil problem že, če je bila glava kasetofona malo postrani nastavljena.
Je bilo pri Spektrumu isto.
Dokler bodo ljudje mislili, da živali ne čutijo bolečine, bodo živali čutile, da ljudje ne mislijowww.S5tech.net
Uporabniški avatar
VolkD
Administratorji strani
 
Prispevkov: 19047
Pridružen: 29 Dec 2014, 20:49
Kraj: Kačiče (Divača)
Zahvalil se je: 3397 krat
Prejel zahvalo: 2706 krat
Uporabnika povabil: Vrtni palček
Število neizkoriščenih povabil: 255

Re: Nostalgična koda

OdgovorNapisal/-a VolkD » 06 Maj 2017, 17:40

gumby je napisal/-a:Podatke iz kaset bi se verjetno dalo dobit nazaj... cviljenje spraviš na PC in spustiš kak program čez, ki "prebere" podatke.
Ko sem ugotovil, da so neuporabne sem jih žal zavrgel.
Dokler bodo ljudje mislili, da živali ne čutijo bolečine, bodo živali čutile, da ljudje ne mislijowww.S5tech.net
Uporabniški avatar
VolkD
Administratorji strani
 
Prispevkov: 19047
Pridružen: 29 Dec 2014, 20:49
Kraj: Kačiče (Divača)
Zahvalil se je: 3397 krat
Prejel zahvalo: 2706 krat
Uporabnika povabil: Vrtni palček
Število neizkoriščenih povabil: 255

Re: Nostalgična koda

OdgovorNapisal/-a DusanK » 06 Maj 2017, 21:34

Trigger te teme je bil dovolj močan, da sem po xx letih zopet odprl škatlo kjer imam nekaj ostankov svoje mladosti, spominov, zgodovine...
Moje skromno začetno programiranje se je začelo s spectrumovim Basicom, vmes nekaj strojnega jezika, nato Dbase III+ in Clipper.

Našel sem zapiske/osnutke (tudi na "neskončnem" papirju) različnih programov od telefonskega pomočnika, ki je preko relejčka namesto tajnice "vrtel" številčnico do raznih obračunov, izpisov računov itd., skratka majhni programčki, ki so v davnih letih (198x --> ) začeli olajševati vsakodnevno delo. Lepi spomini.

Nekaj izsekov Basic in Dbase III+ primerov... telefoniranje, miselna igrica Memo itd.
Collage_Fotor_1 (Custom).jpg
Collage_Fotor_2 (Custom).jpg
Collage_Fotor_3 (Custom).jpg


@VolkD, si pod Cirilom mislil Kraševca ? Zadnja slika desno spodaj. V tej moji škatli sem našel tudi dve št. revije Moj Mikro, junij 1984 (cena 200 dinarjev) in oktober 1988 (cena 3000 din). 8-)
Nimate dovoljenj za ogled prilog tega prispevka.
Največji čar - električar
Uporabniški avatar
DusanK
 
Prispevkov: 1571
Pridružen: 18 Jan 2015, 01:43
Kraj: Medvode
Zahvalil se je: 408 krat
Prejel zahvalo: 710 krat
Uporabnika povabil: VolkD
Število neizkoriščenih povabil: 115

Re: Nostalgična koda

OdgovorNapisal/-a VolkD » 06 Maj 2017, 21:44

DusanK je napisal/-a:@VolkD, si pod Cirilom mislil Kraševca ?
Točno njega, v Radiu študent sva se prvič videla. Zadnjič, pa ko smo proslavljali obletnico revije Moj Mikro. Mislim, da sem takrat edini izpred gostilne odpeljal trezen (pač ne pijem), zato sem bil prvi - in edini sem tudi bil, ki so ga ustavili na preizkušnji alkotesta. In dovolj časa so se z mano ukvarjali, da so vsi ostali odpeljali mimo :)
Dokler bodo ljudje mislili, da živali ne čutijo bolečine, bodo živali čutile, da ljudje ne mislijowww.S5tech.net
Uporabniški avatar
VolkD
Administratorji strani
 
Prispevkov: 19047
Pridružen: 29 Dec 2014, 20:49
Kraj: Kačiče (Divača)
Zahvalil se je: 3397 krat
Prejel zahvalo: 2706 krat
Uporabnika povabil: Vrtni palček
Število neizkoriščenih povabil: 255

Re: Nostalgična koda

OdgovorNapisal/-a VolkD » 06 Maj 2017, 21:47

@DusanK: Ko gledam tvoje slike in vidim ukaz POKE 22432, 17,... me kar groza popade ob misli, da bi tak ukaz obstajal na PC :)
Dokler bodo ljudje mislili, da živali ne čutijo bolečine, bodo živali čutile, da ljudje ne mislijowww.S5tech.net
Uporabniški avatar
VolkD
Administratorji strani
 
Prispevkov: 19047
Pridružen: 29 Dec 2014, 20:49
Kraj: Kačiče (Divača)
Zahvalil se je: 3397 krat
Prejel zahvalo: 2706 krat
Uporabnika povabil: Vrtni palček
Število neizkoriščenih povabil: 255


Vrni se na Ostalo

Kdo je na strani

Po forumu brska: 0 registriranih uporabnikov in 1 gost