Changeset 16137 in project


Ignore:
Timestamp:
10/06/09 21:17:17 (10 years ago)
Author:
sjamaan
Message:

Add Chicken 4 port of Octave, thanks to Christian Kellermann aka C-Keen (I'm just importing it)

Location:
release/4/octave
Files:
2 added
3 edited
1 copied

Legend:

Unmodified
Added
Removed
  • release/4/octave/octave.meta

    r9485 r16137  
    77 (doc-from-wiki)
    88 (author "Pierre-Alexandre Fournier")
    9  (files "octave.setup" "octave.scm" "octave.html"))
     9 (files "octave.setup" "octave.scm" "octave.html" "UPGRADING"))
  • release/4/octave/octave.scm

    r6111 r16137  
    11;;; @Package     octave.scm
    22;;; @Subtitle    A simple interface to GNU/Octave
    3 ;;; @HomePage    http://carretechnologies.com/octave-egg/
     3;;; @HomePage    http://carretechnologies.com/scheme/octave/octave.html
    44;;; @Author      Pierre-Alexandre Fournier
    5 ;;; @AuthorEmail octave-egg@@carretechnologies.com
    6 ;;; @Version     0.4
    7 ;;; @Date        September 17th 2007
     5;;; @AuthorEmail octave@@carretechnologies.com
     6;;; @Version     0.6
     7;;; @Date        April 11th 2008
    88
    99;; $Id:  $
     
    1212;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    1313;;; Octave interface version
    14 (define (octave:version) "0.4")
     14(define (octave:version) "0.6")
    1515
    1616
     
    4242            octave:polar
    4343            octave:bar
     44            octave:stairs
     45            octave:errorbar
    4446            octave:mesh-xyz
    4547            ;; 3d plot functions
     
    5658            octave:figure
    5759            octave:replot
     60            octave:close
    5861            ;; Files
    5962            octave:supported-file-types
     
    6265
    6366  (use posix)
     67
     68  (define octave:conc conc)
     69  (define octave:string-intersperse string-intersperse)
     70
     71
    6472  ;;; Start octave process
    6573  (define (octave:start)
     
    8694 ;;;;;;;;;;;;;;;;;;;;;; Gambit ;;;;;;;;;;;;;;;;;;;;;;;
    8795 (gambit
    88   (define (conc . objs)
     96  (define (octave:conc . objs)
    8997    (with-output-to-string
    9098      "" (lambda () (display objs))))
    9199
    92   (define (string-intersperse lst between)
    93     (if (or (null? lst)
    94             (null? (cdr lst)))
    95         lst
    96         (cons (car lst)
    97               (cons between
    98                     (string-intersperse (cdr lst) between)))))
     100  (define (octave:string-intersperse lst between)
     101    (cond ((null? lst)
     102           lst)
     103          (else
     104           (let loop ((acc (octave:conc (car lst)))
     105                      (lst (cdr lst)))
     106             (cond ((null? lst)
     107                    acc)
     108                   (else
     109                    (loop (octave:conc acc between (car lst))
     110                          (cdr lst))))))))
    99111
    100112  ;;; Start octave process
     
    122134           (display str octave:output-port)
    123135           (force-output octave:output-port))))
    124   ));;; End Gambit
     136  );;; End Gambit
     137
     138 ;;;;;;;;;;;;;;;;;;;;;; Bigloo ;;;;;;;;;;;;;;;;;;;;;;;
     139 (bigloo
     140
     141  (define (octave:conc . objs)
     142    (with-output-to-string
     143        (lambda () (map display objs))))
     144
     145  (define (octave:string-intersperse lst between)
     146    (cond ((null? lst)
     147           lst)
     148          (else
     149           (let loop ((acc (octave:conc (car lst)))
     150                      (lst (cdr lst)))
     151             (cond ((null? lst)
     152                    acc)
     153                   (else
     154                    (loop (octave:conc acc between (car lst))
     155                          (cdr lst))))))))
     156   
     157  ;;; Start octave process
     158  (define (octave:start)
     159    (let ((proc (run-process "octave" "-q" input: pipe:)))
     160      ;;; scheme output goes into process input
     161      (set! octave:input-port  (process-output-port proc))
     162      (set! octave:output-port (process-input-port  proc))
     163      (set! octave:pid         (process-pid         proc))))
     164
     165  ;;; Stop octave process
     166  (define (octave:stop)
     167    (octave:send "quit")
     168    (close-input-port  octave:input-port)
     169    (close-output-port octave:output-port)
     170    (set! octave:input-port  #f)
     171    (set! octave:output-port #f)
     172    (set! octave:pid         #f))
     173
     174  ;;; Send a command to Octave
     175  (define (octave:send str)
     176    (cond ((not octave:output-port)
     177           (error "octave:send"
     178             "Octave process not started. Start it with (octave:start).\n"
     179             (octave:conc (substring str 0 30) "...")))
     180          (else
     181           (display str octave:output-port)
     182           (flush-output-port octave:output-port))))
     183  ));;; End Bigloo
    125184
    126185
     
    133192;;; some utilities
    134193(define (list->octave-vector lst)
    135   (conc "[" (string-intersperse (map conc lst) " ") "]"))
     194  (octave:conc "[" (octave:string-intersperse (map octave:conc lst) " ") "]"))
    136195
    137196(define (list->octave-matrix lst)
    138   (conc "[" (string-intersperse (map list->octave-vector lst) "; ") "]"))
     197  (octave:conc "[" (octave:string-intersperse (map list->octave-vector lst) "; ") "]"))
    139198
    140199;;; verify arguments length for 2d plots
     
    163222                       (list->octave-vector arg))
    164223                      (else
    165                        (conc arg))))
     224                       (octave:conc arg))))
    166225              args)))
    167     (string-intersperse octave-vectors ", ")))
     226    (octave:string-intersperse octave-vectors ", ")))
    168227
    169228(define (args->comma-separated-octave-matrixes args)
    170   (let ((octave-vectors
     229  (let ((octave-matrixes
    171230         (map (lambda (arg)
    172231                (cond ((list? arg)
    173                        (map list->octave-matrix args))
     232                       (list->octave-matrix arg))
    174233                      (else
    175                        (conc arg))))
     234                       (octave:conc arg))))
    176235              args)))
    177     (string-intersperse octave-vectors ", ")))
     236    (octave:string-intersperse octave-matrixes ", ")))
    178237
    179238;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
     
    190249        (else
    191250         (octave:send
    192           (conc plot-function
     251          (octave:conc plot-function
    193252                "(" (args->comma-separated-octave-vectors args) ");\n")))))
    194253
     
    208267(define (octave:mesh-xyz . args)
    209268  (octave:send
    210    (conc "mesh "
     269   (octave:conc "mesh "
    211270          "(" (args->comma-separated-octave-vectors
    212                (take args 2))
     271               (list (car args) (cadr args)))
    213272          "," (args->comma-separated-octave-matrixes
    214273               (list (list-ref args 2)))
     
    224283   (else
    225284    (octave:send
    226      (conc plot-function
     285     (octave:conc plot-function
    227286           "(" (args->comma-separated-octave-matrixes args) ");\n")))))
    228287
     
    248307
    249308;;; title, x and y labels
    250 (define (octave:title  title)  (octave:send (conc "title('"  title  "');\n")))
    251 (define (octave:xlabel xlabel) (octave:send (conc "xlabel('" xlabel "');\n")))
    252 (define (octave:ylabel ylabel) (octave:send (conc "ylabel('" ylabel "');\n")))
     309(define (octave:title  title) 
     310  (octave:send (octave:conc "title('"  title  "');\n")))
     311(define (octave:xlabel xlabel)
     312  (octave:send (octave:conc "xlabel('" xlabel "');\n")))
     313(define (octave:ylabel ylabel)
     314  (octave:send (octave:conc "ylabel('" ylabel "');\n")))
    253315
    254316;;; legend only works with plot, bar
    255317(define (octave:legend . args)
    256318  (define (quote-args args)
    257     (conc (string-intersperse
    258            (map (lambda (s) (conc "'" s "'")) args)
     319    (octave:conc (octave:string-intersperse
     320           (map (lambda (s) (octave:conc "'" s "'")) args)
    259321           ", ")))
    260   (octave:send (conc "legend(" (quote-args args) ");\n")))
     322  (octave:send (octave:conc "legend(" (quote-args args) ");\n")))
    261323
    262324;;; grid on/off
     
    267329                    (else
    268330                     ""))))
    269     (octave:send (conc "grid " off? ";\n"))))
     331    (octave:send (octave:conc "grid " off? ";\n"))))
    270332
    271333;;; replot
     
    280342  ;;; __gnuplot_set__ is an internal Octave function that replaces
    281343  ;;; gset (gset is deprecated)
    282   (octave:send (conc "__gnuplot_set__ terminal " output ";\n")))
     344  (octave:send (octave:conc "__gnuplot_set__ terminal " output ";\n")))
    283345
    284346;;; reset plot output
     
    287349;;; set output
    288350(define (octave:set-output! output)
    289   (octave:send (conc "__gnuplot_set__ output " output ";\n")))
     351  (octave:send (octave:conc "__gnuplot_set__ output " output ";\n")))
    290352
    291353;;; set output file
    292354(define (octave:set-output-file! filename)
    293   (octave:set-output! (conc "'" filename "'")))
     355  (octave:set-output! (octave:conc "'" filename "'")))
    294356
    295357(define (octave:reset-output!)
     
    385447
    386448;;; Shortcuts (not really necessary, I will probably remove them)
    387 (define (octave:save-plot-to-png        filename) (octave:save-plot-to "png"        filename))
    388 (define (octave:save-plot-to-postscript filename) (octave:save-plot-to "postscript" filename))
    389 (define (octave:save-plot-to-gif        filename) (octave:save-plot-to "gif"        filename))
    390 (define (octave:save-plot-to-jpeg       filename) (octave:save-plot-to "jpeg"       filename))
    391 
    392 
    393 ;;; OBSOLETE
    394 ;;;;; aed512  AED 512 Terminal
    395 ;;(define (octave:set-terminal-to-aed512!) (octave:set-terminal! "aed512"))
    396 ;;;;; aed767  AED 767 Terminal
    397 ;;(define (octave:set-terminal-to-aed767!) (octave:set-terminal! "aed767"))
    398 ;;;;; aifm  Adobe Illustrator 3.0 Format
    399 ;;(define (octave:set-terminal-to-aifm!) (octave:set-terminal! "aifm"))
    400 ;;;;; bitgraph  BBN Bitgraph Terminal
    401 ;;(define (octave:set-terminal-to-bitgraph!) (octave:set-terminal! "bitgraph"))
    402 ;;;;; cgm  Computer Graphics Metafile
    403 ;;(define (octave:set-terminal-to-cgm!) (octave:set-terminal! "cgm"))
    404 ;;;;; corel  EPS format for CorelDRAW
    405 ;;(define (octave:set-terminal-to-corel!) (octave:set-terminal! "corel"))
    406 ;;;;; dumb  printer or glass dumb terminal
    407 ;;(define (octave:set-terminal-to-dumb!) (octave:set-terminal! "dumb"))
    408 ;;;;; dxf  dxf-file for AutoCad (default size 120x80)
    409 ;;(define (octave:set-terminal-to-dxf!) (octave:set-terminal! "dxf"))
    410 ;;;;; eepic  EEPIC -- extended LaTeX picture environment
    411 ;;(define (octave:set-terminal-to-eepic!) (octave:set-terminal! "eepic"))
    412 ;;;;; emf  Enhanced Metafile format
    413 ;;(define (octave:set-terminal-to-emf!) (octave:set-terminal! "emf"))
    414 ;;;;; emtex  LaTeX picture environment with emTeX specials
    415 ;;(define (octave:set-terminal-to-emtex!) (octave:set-terminal! "emtex"))
    416 ;;;;; epslatex  LaTeX (Text) and encapsulated PostScript
    417 ;;(define (octave:set-terminal-to-epslatex!) (octave:set-terminal! "epslatex"))
    418 ;;;;; epson_180dpi  Epson LQ-style 180-dot per inch (24 pin) printers
    419 ;;(define (octave:set-terminal-to-epson!) (octave:set-terminal! "epson"))
    420 ;;;;; epson_60dpi  Epson-style 60-dot per inch printers
    421 ;;(define (octave:set-terminal-to-epson!) (octave:set-terminal! "epson"))
    422 ;;;;; epson_lx800  Epson LX-800, Star NL-10, NX-1000, PROPRINTER ...
    423 ;;(define (octave:set-terminal-to-epson!) (octave:set-terminal! "epson"))
    424 ;;;;; fig  FIG graphics language for XFIG graphics editor
    425 ;;(define (octave:set-terminal-to-fig!) (octave:set-terminal! "fig"))
    426 ;;;;; gif  GIF format [mode] [fontsize] [size] [colors]
    427 ;;(define (octave:set-terminal-to-gif!) (octave:set-terminal! "gif"))
    428 ;;;;; gpic  GPIC -- Produce graphs in groff using the gpic preprocessor
    429 ;;(define (octave:set-terminal-to-gpic!) (octave:set-terminal! "gpic"))
    430 ;;;;; hp2623A  HP2623A and maybe others
    431 ;;(define (octave:set-terminal-to-hp2623A!) (octave:set-terminal! "hp2623A"))
    432 ;;;;; hp2648  HP2648 and HP2647
    433 ;;(define (octave:set-terminal-to-hp2648!) (octave:set-terminal! "hp2648"))
    434 ;;;;; hp500c  HP DeskJet 500c, [75 100 150 300] [rle tiff]
    435 ;;(define (octave:set-terminal-to-hp500c!) (octave:set-terminal! "hp500c"))
    436 ;;;;; hpdj  HP DeskJet 500, [75 100 150 300]
    437 ;;(define (octave:set-terminal-to-hpdj!) (octave:set-terminal! "hpdj"))
    438 ;;;;; hpgl  HP7475 and relatives [number of pens] [eject]
    439 ;;(define (octave:set-terminal-to-hpgl!) (octave:set-terminal! "hpgl"))
    440 ;;;;; hpljii  HP Laserjet series II, [75 100 150 300]
    441 ;;(define (octave:set-terminal-to-hpljii!) (octave:set-terminal! "hpljii"))
    442 ;;;;; hppj  HP PaintJet and HP3630 [FNT5X9 FNT9X17 FNT13X25]
    443 ;;(define (octave:set-terminal-to-hppj!) (octave:set-terminal! "hppj"))
    444 ;;;;; imagen  Imagen laser printer
    445 ;;(define (octave:set-terminal-to-imagen!) (octave:set-terminal! "imagen"))
    446 ;;;;; jpeg  JPEG images using libgd and TrueType fonts
    447 ;;(define (octave:set-terminal-to-jpeg!) (octave:set-terminal! "jpeg"))
    448 ;;;;; kc_tek40xx  MS-DOS Kermit Tek4010 terminal emulator - color
    449 ;;(define (octave:set-terminal-to-kc!) (octave:set-terminal! "kc"))
    450 ;;;;; km_tek40xx  MS-DOS Kermit Tek4010 terminal emulator - monochrome
    451 ;;(define (octave:set-terminal-to-km!) (octave:set-terminal! "km"))
    452 ;;;;; latex  LaTeX picture environment
    453 ;;(define (octave:set-terminal-to-latex!) (octave:set-terminal! "latex"))
    454 ;;;;; mf  Metafont plotting standard
    455 ;;(define (octave:set-terminal-to-mf!) (octave:set-terminal! "mf"))
    456 ;;;;; mif  Frame maker MIF 3.00 format
    457 ;;(define (octave:set-terminal-to-mif!) (octave:set-terminal! "mif"))
    458 ;;;;; mp  MetaPost plotting standard
    459 ;;(define (octave:set-terminal-to-mp!) (octave:set-terminal! "mp"))
    460 ;;;;; nec_cp6  NEC printer CP6, Epson LQ-800 [monocrome color draft]
    461 ;;(define (octave:set-terminal-to-nec!) (octave:set-terminal! "nec"))
    462 ;;;;; okidata  OKIDATA 320/321 Standard
    463 ;;(define (octave:set-terminal-to-okidata!) (octave:set-terminal! "okidata"))
    464 ;;;;; pbm  Portable bitmap [small medium large] [monochrome gray color]
    465 ;;(define (octave:set-terminal-to-pbm!) (octave:set-terminal! "pbm"))
    466 ;;;;; pcl5  HP Designjet 750C, HP Laserjet III/IV, etc. (many options)
    467 ;;(define (octave:set-terminal-to-pcl5!) (octave:set-terminal! "pcl5"))
    468 ;;;;; png  PNG images using libgd and TrueType fonts
    469 ;;(define (octave:set-terminal-to-png!) (octave:set-terminal! "png"))
    470 ;;;;; postscript  PostScript graphics language [mode "fontname" font_size]
    471 ;;(define (octave:set-terminal-to-postscript!) (octave:set-terminal! "postscript"))
    472 ;;;;; pslatex  LaTeX picture environment with PostScript \specials
    473 ;;(define (octave:set-terminal-to-pslatex!) (octave:set-terminal! "pslatex"))
    474 ;;;;; pstex  plain TeX with PostScript \specials
    475 ;;(define (octave:set-terminal-to-pstex!) (octave:set-terminal! "pstex"))
    476 ;;;;; pstricks  LaTeX picture environment with PSTricks macros
    477 ;;(define (octave:set-terminal-to-pstricks!) (octave:set-terminal! "pstricks"))
    478 ;;;;; qms  QMS/QUIC Laser printer (also Talaris 1200 and others)
    479 ;;(define (octave:set-terminal-to-qms!) (octave:set-terminal! "qms"))
    480 ;;;;; regis  REGIS graphics language
    481 ;;(define (octave:set-terminal-to-regis!) (octave:set-terminal! "regis"))
    482 ;;;;; selanar  Selanar
    483 ;;(define (octave:set-terminal-to-selanar!) (octave:set-terminal! "selanar"))
    484 ;;;;; starc  Star Color Printer
    485 ;;(define (octave:set-terminal-to-starc!) (octave:set-terminal! "starc"))
    486 ;;;;; svg  W3C Scalable Vector Graphics driver
    487 ;;(define (octave:set-terminal-to-svg!) (octave:set-terminal! "svg"))
    488 ;;;;; table  Dump ASCII table of X Y [Z] values to output
    489 ;;(define (octave:set-terminal-to-table!) (octave:set-terminal! "table"))
    490 ;;;;; tandy_60dpi  Tandy DMP-130 series 60-dot per inch graphics
    491 ;;(define (octave:set-terminal-to-tandy!) (octave:set-terminal! "tandy"))
    492 ;;;;; tek40xx  Tektronix 4010 and others; most TEK emulators
    493 ;;(define (octave:set-terminal-to-tek40xx!) (octave:set-terminal! "tek40xx"))
    494 ;;;;; tek410x  Tektronix 4106, 4107, 4109 and 420X terminals
    495 ;;(define (octave:set-terminal-to-tek410x!) (octave:set-terminal! "tek410x"))
    496 ;;;;; texdraw  LaTeX texdraw environment
    497 ;;(define (octave:set-terminal-to-texdraw!) (octave:set-terminal! "texdraw"))
    498 ;;;;; tgif  TGIF X11 [mode] [x,y] [dashed] ["font" [fontsize]]
    499 ;;(define (octave:set-terminal-to-tgif!) (octave:set-terminal! "tgif"))
    500 ;;;;; tkcanvas  Tk/Tcl canvas widget [perltk] [interactive]
    501 ;;(define (octave:set-terminal-to-tkcanvas!) (octave:set-terminal! "tkcanvas"))
    502 ;;;;; tpic  TPIC -- LaTeX picture environment with tpic \specials
    503 ;;(define (octave:set-terminal-to-tpic!) (octave:set-terminal! "tpic"))
    504 ;;;;; unknown  Unknown terminal type - not a plotting device
    505 ;;(define (octave:set-terminal-to-unknown!) (octave:set-terminal! "unknown"))
    506 ;;;;; vttek  VT-like tek40xx terminal emulator
    507 ;;(define (octave:set-terminal-to-vttek!) (octave:set-terminal! "vttek"))
    508 ;;;;; x11  X11 Window System
    509 ;;(define (octave:set-terminal-to-x11!) (octave:set-terminal! "x11"))
    510 ;;;;; X11  X11 Window System (identical to x11)
    511 ;;(define (octave:set-terminal-to-X11!) (octave:set-terminal! "X11"))
    512 ;;;;; xlib  X11 Window System (gnulib_x11 dump)
    513 ;;(define (octave:set-terminal-to-xlib!) (octave:set-terminal! "xlib"))
    514 
    515 
    516 
    517 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    518 ; TODO: __pltopt__ bar, gplot, gsplot,
     449(define (octave:save-plot-to-png filename)
     450  (octave:save-plot-to "png" filename))
     451(define (octave:save-plot-to-postscript filename)
     452  (octave:save-plot-to "postscript" filename))
     453(define (octave:save-plot-to-gif filename)
     454  (octave:save-plot-to "gif" filename))
     455(define (octave:save-plot-to-jpeg filename)
     456  (octave:save-plot-to "jpeg" filename))
     457
     458
     459
     460;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
     461; TODO: __pltopt__, gplot, gsplot,
    519462
    520463
  • release/4/octave/octave.setup

    r6111 r16137  
    1 
    2 (compile -s -O2 octave.scm)
     1(compile -s -O2 octave-chicken.scm -o octave.so -j octave)
     2(compile -s -O2 octave.import.scm)
    33
    44(install-extension
    55  'octave
    6   '("octave.so" "octave.html" "octave.setup")
     6  '("octave.so" "octave.import.so" "octave.setup")
    77  '((version 0.4)
    88    (documentation "octave.html")))
Note: See TracChangeset for help on using the changeset viewer.