yhara-ticketmap 0.3.1

data/public/scm/board.scm

@@ -0,0 +1,23 @@
+;; NOTE: this is not used now (maybe will be needed for shaking?)
+(define *tickets* (make-eq-hashtable))
+
+(define (tickets-add! ticket)
+  (hashtable-set! *tickets* (ticket 'id) ticket))
+
+(define (tickets-get id)
+  (hashtable-get *tickets* id))
+
+(define (board-on-origin-clicked)
+  (let* ((result (server-ticket-create!))
+         (ticket (make-ticket (cdr result) "" 0 0)))
+    (board-insert-ticket! ticket)
+    (hand-show-ticket ticket)
+    (hand-on-title-clicked)))
+
+(define (board-insert-ticket! ticket)
+  (tickets-add! ticket)
+  (let1 div (ticket 'div)
+    (set-position! div (+ (/ *width* 2) (ticket 'x))
+                       (+ (/ *height* 2) (ticket 'y)))
+    (element-insert! ($ "field") div)))
+

data/public/scm/hand.scm

@@ -0,0 +1,48 @@
+(define *hand-ticket* #f)
+
+(define (hand-show-ticket ticket)
+  (when (not (eq? ticket *hand-ticket*))
+    (set! *hand-ticket* ticket)
+    (set-content! ($ "hand_title") (ticket 'title))
+    (element-hide! ($ "hand_title_submit"))
+    (set-content! ($ "hand_desc")
+                  (string-append "(" 
+                                 (get-style (ticket 'div) "left")
+                                 ","
+                                 (get-style (ticket 'div) "top")
+                                 ")"))))
+
+(define-macro (with-button-toggle button . body)
+  `(unless (element-visible? ,button)
+     (element-show! ,button)
+     ,@body
+     (element-hide! ,button)))
+
+(define (hand-on-title-clicked)
+  (define (make-rename-form old)
+    (string-append "<input type='text' value='" old "' id='rename_text'>"))
+
+  (let1 ok-button ($ "hand_title_submit")
+    (with-button-toggle ok-button
+      (element-update! ($ "hand_title") 
+                       (make-rename-form (get-content ($ "hand_title"))))
+      (js-invoke ($ "rename_text") "focus")
+
+      (wait-for ok-button "click")
+
+      (let1 new-title (get-content ($ "rename_text"))
+        (*hand-ticket* 'title= new-title)
+        (element-update! ($ "hand_title") new-title)
+        (element-update! (*hand-ticket* 'div) new-title)
+        (server-ticket-rename! *hand-ticket* new-title)))))
+
+(define (hand-on-delete-clicked)
+  (when *hand-ticket*
+    (when (confirm (string-append "really delete '"
+                                  (*hand-ticket* 'title)
+                                  "' ?"))
+      (server-ticket-delete! *hand-ticket*)
+      (element-remove! (*hand-ticket* 'div))
+      (set! *hand-ticket* #f)
+      (element-clear! ($ "hand_title"))
+      (element-clear! ($ "hand_desc")))))

data/public/scm/main.scm

@@ -0,0 +1,69 @@
+;;;
+;;; main.scm
+;;;
+
+;; load
+(for-each (lambda (pair)
+            (js-load (string-append "js/" (car pair) ".js")
+                     (cdr pair)))
+          '(("scriptaculous" . "Scriptaculous")
+            ("builder" . "Builder")
+            ("effects" . "Effect")
+            ("dragdrop" . "Draggable")
+            ("controls" . "Autocompleter")
+            ("slider" . "Control")
+            ("sound" . "Sound")))
+
+(load "scm/ticket.scm")
+(load "scm/board.scm")
+(load "scm/hand.scm")
+(load "scm/server.scm")
+
+;; consts
+
+(define (px n)
+  (string-append (number->string n) "px"))
+
+(define (set-position! elem x y)
+  (set-style! elem "position" "absolute") 
+  (set-style! elem "left" (px x))
+  (set-style! elem "top" (px y)))
+
+(define (get-position elem)
+  (define (remove-px str)
+    (string->number (car (regexp-exec "(\\d+)" str))))
+  (values (remove-px (get-style elem "left"))
+          (remove-px (get-style elem "top"))))
+
+(define *width* #f)
+(define *height* #f)
+
+;; util
+(define show-error print)
+
+;; initialize
+(let1 result (read-from-string (http-request "config/board_size"))
+  (if (eq? (car result) 'xy)
+    (begin
+      (set! *width*  (cadr result))
+      (set! *height* (cddr result)))
+    (show-error "error: failed to load board size")))
+
+(set-style! ($ "field") "width" (px *width*))
+(set-style! ($ "field") "height" (px *height*))
+(set-position! ($ "top")    (/ *width* 2) 0)
+(set-position! ($ "bottom") (/ *width* 2) *height*)
+(set-position! ($ "right")  *width* (/ *height* 2))
+(set-position! ($ "left")   0       (/ *height* 2))
+(set-position! ($ "origin") (/ *width* 2) (/ *height* 2))
+
+(add-handler! ($ "origin") "click" board-on-origin-clicked)
+
+(add-handler! ($ "hand_title") "click" hand-on-title-clicked)
+(add-handler! ($ "hand_delete") "click" hand-on-delete-clicked)
+
+(for-each (lambda (vals) 
+            (board-insert-ticket! (apply make-ticket vals)))
+          (server-ticket-list))
+
+(display "ok")

data/public/scm/server.scm

@@ -0,0 +1,30 @@
+(define (server-request url . params)
+  (define (params->alist list)
+    (cond
+      ((null? list) '())
+      ((null? (cdr list)) (show-error "must not happen"))
+      (else (cons (cons (symbol->string (car list)) (cadr list))
+                  (params->alist (cddr list))))))
+  (define (http url params)
+    (if (null? params)
+      (http-request url)
+      (http-post url (params->alist params))))
+  (let1 result (read-from-string (http url params))
+    (if (eq? #t (car result))
+      (cdr result)
+      (show-error "error: got wrong response from " url))))
+
+(define (server-ticket-list)
+  (server-request "tickets/list"))
+
+(define (server-ticket-create!)
+  (server-request "tickets/create"))
+
+(define (server-ticket-move! ticket x y)
+  (server-request "tickets/move/" 'id (ticket 'id) 'x x 'y y))
+
+(define (server-ticket-rename! ticket new-title)
+  (server-request "tickets/rename" 'id (ticket 'id) 'title new-title))
+
+(define (server-ticket-delete! ticket)
+  (server-request "tickets/delete" 'id (ticket 'id)))

data/public/scm/ticket.scm

@@ -0,0 +1,44 @@
+(define (make-ticket id title x y)
+  (define (check-title title)
+    (if (string=? title "") "(no title)" title))
+
+  (let* ((self #f)
+         (id id)
+         (title (check-title title))
+         (x x)
+         (y y)
+         (div (element-new `("div.ticket" ,title))))
+
+    (add-handler! div "click" 
+                  (lambda (ev) ((self 'on-click))))
+    (js-new "Draggable" div 
+            'onEnd (lambda (drg) ((self 'on-drag-end))))
+
+    (set! self
+      (lambda (method . args)
+        (case method
+          ; properties
+          ((id) id)
+          ((title) title)
+          ((title=) (set! title (check-title (car args))))
+          ((x) x)
+          ((y) y)
+          ((div) div)
+
+          ; methods
+          ((on-click)
+           (lambda ()
+             (hand-show-ticket self)))
+
+          ((on-drag-end)
+           (lambda ()
+             (call-with-values 
+               (lambda () (get-position div))
+               (lambda (newx newy)
+                 (server-ticket-move! self
+                                      (- newx (/ *width* 2))
+                                      (- newy (/ *height* 2)))))))
+          ; method_missing
+          (else
+            (show-error "unknown method:" method)))))
+    self))

data/spec/config.rb

@@ -0,0 +1,13 @@
+require 'spec/helper.rb'
+load 'bin/tickets-server'
+
+describe ConfigController do
+  behaves_like :rack_test
+
+  # board_size
+
+  it 'returns board size' do
+    get('/config/board_size').status.should == 200
+    last_response.should =~ /\(xy . \(\d+ . \d+\)\)/
+  end
+end

data/spec/helper.rb

@@ -0,0 +1,2 @@
+require 'ramaze/spec/bacon'
+ARGV.concat ["--db", __DIR__("../db/test.db")]

data/spec/main.rb

@@ -0,0 +1,13 @@
+require 'spec/helper.rb'
+load 'bin/tickets-server'
+
+describe MainController do
+  behaves_like :rack_test
+
+  # index
+
+  it 'shows start page' do
+    get('/').status.should == 200
+    last_response.should =~ /biwascheme\.js/
+  end
+end

data/spec/models.rb

@@ -0,0 +1,34 @@
+require 'spec/helper.rb'
+load 'bin/tickets-server'
+
+describe Ticket do
+  before do
+    Ticket.all.destroy!
+  end
+
+  # instantiation
+
+  it 'fills blank attributes' do
+    t = Ticket.create
+    t.importance.should.not == nil
+    t.emergency.should.not == nil
+    t.title.should.not == nil
+    t.deleted.should == false
+    t.timeouted.should == false
+  end
+
+  # shaking
+
+  it 'detects when to shake' do 
+    TicketMap.options[:shake_interval] = 0
+    Ticket.needs_shaking?.should == true
+  end
+
+  it 'should move tickets' do
+    Ticket.create(:emergency => 0, :importance => -10,  :title => "test1")
+    Ticket.create(:emergency => 0, :importance => 10, :title => "test2")
+    Ticket.shake!
+    Ticket.first(:title => "test1").emergency.should > 0
+    Ticket.first(:title => "test2").emergency.should < 0
+  end
+end

data/spec/tickets.rb

@@ -0,0 +1,65 @@
+require 'spec/helper.rb'
+load 'bin/tickets-server'
+
+describe TicketsController do
+  behaves_like :rack_test
+
+  before do
+    Ticket.all.destroy!
+  end
+
+  # create
+
+  it 'creates new ticket' do
+    lambda{
+      get('/tickets/create').should =~ /\A\(#t . \(id . (\d+)\)\)\z/
+    }.should.change{ Ticket.count }
+  end
+  
+  # list
+
+  it 'enumerates created tickets' do
+    Ticket.create(:title => "test1")
+    Ticket.create(:title => "test2")
+
+    get('/tickets/list')
+
+    last_response.should =~ /test1/
+    last_response.should =~ /test2/
+  end
+  
+  # list
+
+  it 'moves a ticket' do
+    id = get('/tickets/create').match(/\A\(#t . \(id . (\d+)\)\)\z/)[1]
+
+    post('/tickets/move', :id => id, :x => 10, :y => -10)
+    last_response.body.should == "(#t)"
+
+    Ticket.first.emergency.should == 10
+    Ticket.first.importance.should == -10
+  end
+
+  # rename
+
+  it 'renames a ticket' do
+    id = get('/tickets/create').match(/\A\(#t . \(id . (\d+)\)\)\z/)[1]
+
+    post('/tickets/rename', :id => id, :title => "test1")
+    last_response.body.should == "(#t)"
+
+    Ticket.first.title.should == "test1"
+  end
+
+  # delete
+  
+  it 'deletes a ticket' do
+    id = get('/tickets/create').match(/\A\(#t . \(id . (\d+)\)\)\z/)[1]
+
+    post('/tickets/delete', :id => id)
+    last_response.body.should == "(#t)"
+
+    Ticket.first.deleted.should == true
+  end
+
+end

data/ticketmap.gemspec

@@ -0,0 +1,96 @@
+# -*- encoding: utf-8 -*-
+#
+
+Gem::Specification.new do |s|
+  s.name = %q{ticketmap}
+  s.version = "0.3.1"
+
+  s.required_rubygems_version = Gem::Requirement.new(">= 0") if s.respond_to? :required_rubygems_version=
+  s.authors = ["Yutaka HARA"]
+  s.date = %q{2009-07-18}
+  s.description = %q{Two-dimentional ToDo manager}
+  s.email = %q{yutaka.hara/at/gmail.com}
+  s.extra_rdoc_files = [
+    "README.rdoc"
+  ]
+  s.files = [
+    ".gitignore",
+     ".gitmodules",
+     "MANIFEST",
+     "README.rdoc",
+     "Rakefile",
+     "TODO",
+     "VERSION",
+     "controller/config.rb",
+     "controller/init.rb",
+     "controller/main.rb",
+     "controller/tickets.rb",
+     "db/migrate/001_create_tickets.rb",
+     "db/migrate/002_add_deleted_to_tickets.rb",
+     "db/migrate/003_add_timeouted_to_tickets.rb",
+     "main.rb",
+     "model/init.rb",
+     "model/ticket.rb",
+     "public/biwascheme/lib/biwascheme.js",
+     "public/biwascheme/lib/dumper.js",
+     "public/biwascheme/lib/extra_lib.js",
+     "public/biwascheme/lib/io.js",
+     "public/biwascheme/lib/prototype.js",
+     "public/biwascheme/lib/r6rs_lib.js",
+     "public/biwascheme/lib/stackbase.js",
+     "public/biwascheme/lib/webscheme_lib.js",
+     "public/js/builder.js",
+     "public/js/controls.js",
+     "public/js/dragdrop.js",
+     "public/js/effects.js",
+     "public/js/scriptaculous.js",
+     "public/js/slider.js",
+     "public/js/sound.js",
+     "public/js/unittest.js",
+     "public/scm/board.scm",
+     "public/scm/hand.scm",
+     "public/scm/main.scm",
+     "public/scm/server.scm",
+     "public/scm/ticket.scm",
+     "spec/config.rb",
+     "spec/helper.rb",
+     "spec/main.rb",
+     "spec/models.rb",
+     "spec/tickets.rb",
+     "ticketmap.gemspec",
+     "view/index.xhtml",
+     "view/track.xhtml"
+  ]
+  s.has_rdoc = true
+  s.homepage = %q{http://github.com/yhara/ticketmap}
+  s.rdoc_options = ["--charset=UTF-8"]
+  s.require_paths = ["lib"]
+  s.rubygems_version = %q{1.3.2}
+  s.summary = %q{Two-dimentional ToDo manager}
+  s.test_files = [
+    "spec/config.rb",
+     "spec/helper.rb",
+     "spec/main.rb",
+     "spec/models.rb",
+     "spec/tickets.rb"
+  ]
+
+  if s.respond_to? :specification_version then
+    current_version = Gem::Specification::CURRENT_SPECIFICATION_VERSION
+    s.specification_version = 3
+
+    if Gem::Version.new(Gem::RubyGemsVersion) >= Gem::Version.new('1.2.0') then
+      s.add_runtime_dependency(%q<ramaze>, ["= 2009.06.12"])
+      s.add_runtime_dependency(%q<dm-core>, [">= 0"])
+      s.add_runtime_dependency(%q<do_sqlite3>, [">= 0"])
+    else
+      s.add_dependency(%q<ramaze>, ["= 2009.06.12"])
+      s.add_dependency(%q<dm-core>, [">= 0"])
+      s.add_dependency(%q<do_sqlite3>, [">= 0"])
+    end
+  else
+    s.add_dependency(%q<ramaze>, ["= 2009.06.12"])
+    s.add_dependency(%q<dm-core>, [">= 0"])
+    s.add_dependency(%q<do_sqlite3>, [">= 0"])
+  end
+end